diff --git a/CREDITS.txt b/CREDITS.txt new file mode 100644 --- /dev/null +++ b/CREDITS.txt @@ -0,0 +1,13 @@ +AUTHORS + +Arjan van IJzendoorn, Bastiaan Heeren, Jurriaan Hage + +CREDITS + +The following people have contributed to the development and testing of the +Helium compiler and its components: + +Daan Leijen, Rijk-Jan van Haaften, Arie Middelkoop, Arjan Oosting, +Jurri‘n Stutterheim, Jeroen Fokker, Andres Lšh, Arthur Baars, Remco Burema, +Atze Dijkstra, Maarten van Gompel, Doaitse Swierstra, Martijn Lammerts, +Martijn Schrage and Stefan Holdermans. diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, 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 +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If 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 convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU 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 +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "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 PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state 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 program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program 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 General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/helium.cabal b/helium.cabal new file mode 100644 --- /dev/null +++ b/helium.cabal @@ -0,0 +1,215 @@ +name: helium +version: 1.8 +synopsis: The Helium Compiler. +homepage: http://www.cs.uu.nl/wiki/bin/view/Helium/WebHome +description: + + Helium is a compiler for a subset of Haskell that aims at delivering high + quality type error messages particularly for beginner programmers. It also + includes facilities for specializing type error diagnosis for embedded domain + specific languages. The compiler supports Haskell 98, but without the ability + to define new type classes and instances. + +category: Compiler +copyright: (c) 2014 +license: GPL +license-file: LICENSE.txt +author: Bastiaan Heeren, Jurriaan Hage +maintainer: helium@cs.uu.nl +stability: provisional +extra-source-files: + CREDITS.txt + src/Makefile + src/Helium/CodeGeneration/CodeGeneration.ag + src/Helium/CodeGeneration/ToCoreDecl.ag + src/Helium/CodeGeneration/ToCoreExpr.ag + src/Helium/CodeGeneration/ToCoreModule.ag + src/Helium/CodeGeneration/ToCoreName.ag + src/Helium/CodeGeneration/ToCorePat.ag + src/Helium/ModuleSystem/ExtractImportDecls.ag + src/Helium/Parser/ResolveOperators.ag + src/Helium/StaticAnalysis/Directives/TS_Analyse.ag + src/Helium/StaticAnalysis/Directives/TS_Apply.ag + src/Helium/StaticAnalysis/Directives/TS_Collect.ag + src/Helium/StaticAnalysis/Directives/TS_CoreSyntax.ag + src/Helium/StaticAnalysis/Directives/TS_PatternMatching.ag + src/Helium/StaticAnalysis/Directives/TS_Syntax.ag + src/Helium/StaticAnalysis/Directives/TS_ToCore.ag + src/Helium/StaticAnalysis/Inferencers/GlobalInfo.ag + src/Helium/StaticAnalysis/Inferencers/KindInferencing.ag + src/Helium/StaticAnalysis/Inferencers/LocalInfo.ag + src/Helium/StaticAnalysis/Inferencers/PatternMatchWarnings.ag + src/Helium/StaticAnalysis/Inferencers/TypeInferenceCollect.ag + src/Helium/StaticAnalysis/Inferencers/TypeInferenceInfo.ag + src/Helium/StaticAnalysis/Inferencers/TypeInferenceOverloading.ag + src/Helium/StaticAnalysis/Inferencers/TypeInferenceRules.ag + src/Helium/StaticAnalysis/Inferencers/TypeInferencing.ag + src/Helium/StaticAnalysis/StaticChecks/Collect.ag + src/Helium/StaticAnalysis/StaticChecks/ExportErrors.ag + src/Helium/StaticAnalysis/StaticChecks/HeliumPartialSyntax.ag + src/Helium/StaticAnalysis/StaticChecks/KindChecking.ag + src/Helium/StaticAnalysis/StaticChecks/MiscErrors.ag + src/Helium/StaticAnalysis/StaticChecks/Scope.ag + src/Helium/StaticAnalysis/StaticChecks/ScopeErrors.ag + src/Helium/StaticAnalysis/StaticChecks/StaticChecks.ag + src/Helium/StaticAnalysis/StaticChecks/TopLevelErrors.ag + src/Helium/StaticAnalysis/StaticChecks/Warnings.ag + src/Helium/Syntax/UHA_OneLine.ag + src/Helium/Syntax/UHA_Pretty.ag + src/Helium/Syntax/UHA_Syntax.ag +build-type: Simple +cabal-version: >= 1.10.1.0 +tested-with: GHC == 7.6.3 +data-files: + lib/Char.hs + lib/HeliumLang.core + lib/List.hs + lib/LvmException.core + lib/LvmIO.core + lib/LvmLang.core + lib/Makefile + lib/Maybe.hs + lib/Prelude.hs + lib/Prelude.type + lib/PreludePrim.core + lib/simple/Char.hs + lib/simple/HeliumLang.core + lib/simple/List.hs + lib/simple/LvmException.core + lib/simple/LvmIO.core + lib/simple/LvmLang.core + lib/simple/Makefile + lib/simple/Maybe.hs + lib/simple/Prelude.hs + lib/simple/Prelude.type + lib/simple/PreludePrim.core + hint.conf + +source-repository head + type: svn + location: https://subversion.cs.uu.nl/repos/staff.jur.Top/trunk + +-------------------------------------------------------------------------------- + +Executable helium + Build-Depends: base >= 3 && < 5, containers, mtl, parsec, network, process, transformers, filepath, directory, wl-pprint, Top >= 1.7, lvmlib >= 1.1 + ghc-options: -Wall + default-language: Haskell98 + hs-source-dirs: src + Main-is: Helium/Main.hs + other-modules: Paths_helium + +-------------------------------------------------------------------------------- + +Executable texthint + Build-Depends: base >= 3 && < 5, containers, mtl, filepath, parsec, directory, process + ghc-options: -Wall + default-language: Haskell98 + hs-source-dirs: src + Main-is: TextHint/Main.hs + other-modules: Paths_helium, TextHint.ConfigFile + +-------------------------------------------------------------------------------- + +Executable runhelium + Build-Depends: base >= 3 && < 5, containers, filepath, directory, parsec, process + ghc-options: -Wall + default-language: Haskell98 + hs-source-dirs: src + Main-is: RunHelium/Main.hs + other-modules: Paths_helium + +-------------------------------------------------------------------------------- + +Library + Build-Depends: base >= 3 && < 5, containers, mtl, parsec, network, process, transformers, filepath, directory, wl-pprint, Top >= 1.7, lvmlib >= 1.1 + ghc-options: -Wall + default-language: Haskell98 + hs-source-dirs: src + + + Exposed-modules: + Helium.CodeGeneration.CodeGeneration + Helium.CodeGeneration.CoreToLvm + Helium.CodeGeneration.CoreUtils + Helium.CodeGeneration.DerivingEq + Helium.CodeGeneration.DerivingShow + Helium.CodeGeneration.PatternMatch + Helium.Main.Args + Helium.Main.Compile + Helium.Main.CompileUtils + Helium.Main.PhaseCodeGenerator + Helium.Main.PhaseDesugarer + Helium.Main.PhaseImport + Helium.Main.PhaseKindInferencer + Helium.Main.PhaseLexer + Helium.Main.PhaseParser + Helium.Main.PhaseResolveOperators + Helium.Main.PhaseStaticChecks + Helium.Main.PhaseTypeInferencer + Helium.Main.PhaseTypingStrategies + Helium.Main.Version + Helium.ModuleSystem.CoreToImportEnv + Helium.ModuleSystem.DictionaryEnvironment + Helium.ModuleSystem.ExtractImportDecls + Helium.ModuleSystem.ImportEnvironment + Helium.Parser.CollectFunctionBindings + Helium.Parser.LayoutRule + Helium.Parser.Lexer + Helium.Parser.LexerMessage + Helium.Parser.LexerMonad + Helium.Parser.LexerToken + Helium.Parser.OperatorTable + Helium.Parser.ParseLibrary + Helium.Parser.ParseMessage + Helium.Parser.Parser + Helium.Parser.ResolveOperators + Helium.StaticAnalysis.Directives.Matchers + Helium.StaticAnalysis.Directives.TS_Analyse + Helium.StaticAnalysis.Directives.TS_Apply + Helium.StaticAnalysis.Directives.TS_Attributes + Helium.StaticAnalysis.Directives.TS_Compile + Helium.StaticAnalysis.Directives.TS_CoreSyntax + Helium.StaticAnalysis.Directives.TS_Messages + Helium.StaticAnalysis.Directives.TS_Parser + Helium.StaticAnalysis.Directives.TS_Syntax + Helium.StaticAnalysis.Directives.TS_ToCore + Helium.StaticAnalysis.Heuristics.HeuristicsInfo + Helium.StaticAnalysis.Heuristics.ListOfHeuristics + Helium.StaticAnalysis.Heuristics.OnlyResultHeuristics + Helium.StaticAnalysis.Heuristics.RepairHeuristics + Helium.StaticAnalysis.Heuristics.TieBreakerHeuristics + Helium.StaticAnalysis.Heuristics.UnifierHeuristics + Helium.StaticAnalysis.Inferencers.BindingGroupAnalysis + Helium.StaticAnalysis.Inferencers.ExpressionTypeInferencer + Helium.StaticAnalysis.Inferencers.KindInferencing + Helium.StaticAnalysis.Inferencers.SelectConstraintSolver + Helium.StaticAnalysis.Inferencers.TypeInferencing + Helium.StaticAnalysis.Messages.HeliumMessages + Helium.StaticAnalysis.Messages.Information + Helium.StaticAnalysis.Messages.KindErrors + Helium.StaticAnalysis.Messages.Messages + Helium.StaticAnalysis.Messages.StaticErrors + Helium.StaticAnalysis.Messages.TypeErrors + Helium.StaticAnalysis.Messages.Warnings + Helium.StaticAnalysis.Miscellaneous.ConstraintInfo + Helium.StaticAnalysis.Miscellaneous.DoublyLinkedTree + Helium.StaticAnalysis.Miscellaneous.TypeConstraints + Helium.StaticAnalysis.Miscellaneous.TypeConversion + Helium.StaticAnalysis.Miscellaneous.TypesToAlignedDocs + Helium.StaticAnalysis.Miscellaneous.UHA_Source + Helium.StaticAnalysis.StaticChecks.StaticChecks + Helium.Syntax.UHA_OneLine + Helium.Syntax.UHA_Pretty + Helium.Syntax.UHA_Range + Helium.Syntax.UHA_Syntax + Helium.Syntax.UHA_Utils + Helium.Utils.Logger + Helium.Utils.OneLiner + Helium.Utils.Similarity + Helium.Utils.Texts + Helium.Utils.Utils + Other-modules: + + + diff --git a/hint.conf b/hint.conf new file mode 100644 --- /dev/null +++ b/hint.conf @@ -0,0 +1,9 @@ +#Hint + +additionalheliumparameters= +fontsize=14 +lvmpaths=. +loggingon=false +overloadingon=true +host=helium.zoo.cs.uu.nl +port=5010 diff --git a/lib/Char.hs b/lib/Char.hs new file mode 100644 --- /dev/null +++ b/lib/Char.hs @@ -0,0 +1,39 @@ +module Char where + +ord :: Char -> Int +ord = primOrd + +chr :: Int -> Char +chr = primChr + +isSpace :: Char -> Bool +isSpace c = + i == ord ' ' || i == ord '\t' || i == ord '\n' || + i == ord '\r' || i == ord '\f' || i == ord '\v' + where + i = ord c + +isUpper :: Char -> Bool +isUpper c = ord c >= ord 'A' && ord c <= ord 'Z' + +isLower :: Char -> Bool +isLower c = ord c >= ord 'a' && ord c <= ord 'z' + +isDigit :: Char -> Bool +isDigit c = ord c >= ord '0' && ord c <= ord '9' + +isAlpha :: Char -> Bool +isAlpha c = isUpper c || isLower c + +isAlphaNum :: Char -> Bool +isAlphaNum c = isAlpha c || isDigit c + +toUpper :: Char -> Char +toUpper c + | isLower c = chr ( ord c - ord 'a' + ord 'A' ) + | otherwise = c + +toLower :: Char -> Char +toLower c + | isUpper c = chr ( ord c - ord 'A' + ord 'a' ) + | otherwise = c diff --git a/lib/HeliumLang.core b/lib/HeliumLang.core new file mode 100644 --- /dev/null +++ b/lib/HeliumLang.core @@ -0,0 +1,423 @@ +{- The (type) constructors and functions in this module are + used in the translation of language constructs. +-} + +module HeliumLang + ( Bool(True, False) + , '':[]''('':[]'', (:)) -- lists + , '':()''('':()'') -- unit tuple + , '':->'' -- function arrow + , String, Int, Float, IO, Char + + , showFunction, showIO, showPolymorphic -- all show functions are used in inserted main + , showChar, showString, showInt, showList, showBool, showUnit, showFloat + , showTuple2, showTuple3, showTuple4, showTuple5, showTuple6, showTuple7 + , showTuple8, showTuple9, showTuple10 + + , ''$primPutStrLn'' -- inserted main + , ''$primPutChar'', ''$primPutStr'' -- necessary for ''$primPutStrLn'' + , ''$primBindIO'' -- do-notation + , ''$primUnsafePerformIO'' -- inserted main + , ''$primPatternFailPacked'' -- pattern-match failed runtime error + , ''$primEnumFrom'', ''$primEnumFromThen'', ''$primEnumFromTo'', ''$primEnumFromThenTo'' -- [1..] etc + , ''$primNegFloat'' -- unary minus for Expression_NegateFloat. Unnecessary in overloaded Helium? + , ''$primStringToFloat'' -- float literals + , ''$primEqFloat'' -- pattern-matching on floats + , ''$primConcat'' -- derived show functions + , ''$primConcatMap'' -- list comprehensions + , ''$primPackedToString'' -- string literals and the built-in string "No main defined..." and derived shows + + , ''$negate'' + , ''$enumFrom'', ''$enumFromThen'', ''$enumFromTo'', ''$enumFromThenTo'' + , ''$floatUnaryMinus'' + , ''$show'', ''$showList'' + ) where + +import LvmLang + ( Int(), Float(), IO() + , custom "typedecl" String + , Bool(True, False) + , '':[]''('':[]'', (:)) + , '':()''('':()'') + , ''$primBindIO'' = bindIO, ''$primReturnIO'' = returnIO + , negInt + , negFloat, ''$primEqFloat'' = (==.) + , (+), (-), (>), (<), (>=), quot, rem, (==) + , stringFromPacked + , unsafePerformIO + ) +import LvmIO + ( stdin, stdout, stderr, flush, outputChar, outputPacked + ) +import LvmException + ( errorPacked + , patternFailPacked + ) + +{---------------------------------------------------------- + Fixities +----------------------------------------------------------} +custom infix (:) : public [5,"right"] + +{-------------------------------------------------------------------------- + Built into the language +--------------------------------------------------------------------------} +''$negate'' :: "Num a => a -> a" +''$negate'' dNum = + case dNum of + (@0, 7) x1 x2 x3 x4 x5 x6 x7 -> x6 + + +''$enumFrom'' :: "Enum a => a -> [a]" +''$enumFrom'' dEnum = + case dEnum of + (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> x3 + +''$enumFromThen'' :: "Enum a => a -> a -> [a]" +''$enumFromThen'' dEnum = + case dEnum of + (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> x4 + +''$enumFromTo'' :: "Enum a => a -> a -> [a]" +''$enumFromTo'' dEnum = + case dEnum of + (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> x7 + +''$enumFromThenTo'' :: "Enum a => a -> a -> a -> [a]" +''$enumFromThenTo'' dEnum = + case dEnum of + (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> x8 + +''$floatUnaryMinus'' :: "Float -> Float" +''$floatUnaryMinus'' f + = ''$primNegFloat'' f + +''$show'' :: "Show a => a -> String" +''$show'' dShow = + case dShow of + (@0, 2) x1 x2 -> x1 + +''$showList'' :: "(a -> String) -> [a] -> String" +''$showList'' = showList + +{---------------------------------------------------------- + Basic data types +----------------------------------------------------------} +data '':->'' x y +-- Daan has type Char = Int +data Char + +''$primPackedToString'' :: PackedString -> String +''$primPackedToString'' p + = stringFromPacked p + +''$primUnsafePerformIO'' :: IO a -> a +''$primUnsafePerformIO'' io + = unsafePerformIO io + +''$primPatternFailPacked'' :: PackedString -> a +''$primPatternFailPacked'' p + = patternFailPacked p + +''$primErrorPacked'' :: PackedString -> a +''$primErrorPacked'' p + = errorPacked p + +''$primPutChar'' :: Char -> IO () +''$primPutChar'' c = + ''$primBindIO'' + (outputChar stdout c) + (flush stdout) + +''$primPutChars'' :: String -> IO () +''$primPutChars'' xs = + case xs of { + '':[]'' -> ''$primReturnIO'' '':()'' ; + (:) y ys -> ''$primBindIO'' + (''$primPutChar'' y) -- if you don't want to flush each character: (outputChar stdout y) + (''$primPutChars'' ys) } + +''$primPutStr'' :: String -> IO () +''$primPutStr'' xs = + ''$primBindIO'' + (''$primPutChars'' xs) + (flush stdout) + +''$primPutStrLn'' :: String -> IO () +''$primPutStrLn'' xs = + ''$primBindIO'' + (''$primPutChars'' xs) + (''$primPutChar'' '\n') -- does the flush + +''$primNegInt'' :: Int -> Int! +''$primNegInt'' = negInt + +''$primConcat'' :: [[a]] -> [a] +''$primConcat'' xss = + case xss of + { '':[]'' -> [] + ; (:) ys yss -> ''$primAppend'' ys (''$primConcat'' yss) + } + +''$primConcatMap'' :: (a -> [b]) -> [a] -> [b] +''$primConcatMap'' f xs = + case xs of + { '':[]'' -> [] + ; (:) y ys -> ''$primAppend'' (f y) (''$primConcatMap'' f ys) + } + +''$primAppend'' :: [a] -> [a] -> [a] -- is '++' +''$primAppend'' xs ys = + case xs of + { '':[]'' -> ys + ; (:) z zs -> (:) z (''$primAppend'' zs ys) + } + +-- the ''$primEnum'' functions are used in the translation of the .. notation +-- [1..10] === ''$primEnumFromTo'' 1 10 +-- [1..] === ''$primEnumFrom'' 1 +-- [1,3..10] === ''$primEnumFromThenTo'' 1 3 10 +-- [1,3..] === ''$primEnumFromThen'' 1 3 + +''$primEnumFrom'' :: Int -> [Int] +''$primEnumFrom'' n = (:) n (''$primEnumFrom'' ((+) n 1)) + +''$primEnumFromTo'' :: Int -> Int -> [Int] +''$primEnumFromTo'' n m = + case (>) n m of + { True -> [] + ; _ -> (:) n (''$primEnumFromTo'' ((+) n 1) m) + } + +''$primEnumFromThenTo'' :: Int -> Int -> Int -> [Int] +''$primEnumFromThenTo'' n a m = + case (>) a n of + { True -> ''$primAscendToWithStep'' n m ((-) a n) + ; _ -> ''$primDescendToWithStep'' n m ((-) a n) + } + +''$primAscendToWithStep'' :: Int -> Int -> Int -> [Int] +''$primAscendToWithStep'' n m step = + case (>) n m of + { True -> [] + ; _ -> (:) n (''$primAscendToWithStep'' ((+) n step) m step) + } + + +''$primDescendToWithStep'' :: Int -> Int -> Int -> [Int] +''$primDescendToWithStep'' n m step = + case (<) n m of + { True -> [] + ; _ -> (:) n (''$primDescendToWithStep'' ((+) n step) m step) + } + +''$primEnumFromThen'' :: Int -> Int -> [Int] +''$primEnumFromThen'' n a = (:) n (''$primEnumFromThen'' a ((+) a ((-) a n))) + +-- Show + +showBool :: Bool -> String +showBool b = + case b of + { True -> stringFromPacked "True" + ; _ -> stringFromPacked "False" + } + +showUnit :: () -> String +showUnit u = + case u of + { '':()'' -> stringFromPacked "()" + } + +showFunction :: (a -> String) -> (b -> String) -> (a->b) -> String +showFunction a b x = let! x = x in stringFromPacked "<>" + +showIO :: (a -> String) -> IO a -> String +showIO a x = let! x = x in stringFromPacked "<>" + +showChar :: Char -> String +showChar c = + (:) '\'' (''$primAppend'' (safeShowChar True c) + [ '\'' ]) + +safeShowChar :: Bool -> Char -> String +safeShowChar inChar c = + case c of + { '\a' -> stringFromPacked "\\a" + ; '\b' -> stringFromPacked "\\b" + ; '\f' -> stringFromPacked "\\f" + ; '\n' -> stringFromPacked "\\n" + ; '\r' -> stringFromPacked "\\r" + ; '\t' -> stringFromPacked "\\t" + ; '\\' -> stringFromPacked "\\\\" + ; '\'' -> case inChar of { True -> stringFromPacked "\\'" + ; _ -> [c] + } + ; '\"' -> case inChar of { True -> [c] + ; _ -> stringFromPacked "\\\"" + } + ; _ -> + case logicalAnd ((>=) c 32) ((<) c 127) of + { True -> [c] + ; _ -> (:) '\\' (showInt c) + } + } + +logicalAnd :: Bool -> Bool -> Bool +logicalAnd b1 b2 = + case b1 of + { True -> b2 + ; _ -> False + } + +showString :: String -> String +showString s = + (:) '\"' (''$primAppend'' (''$primConcatMap'' (safeShowChar False) s) + (stringFromPacked "\"")) + +showInt :: Int -> String +showInt n = + case (<) n 0 of + { True -> (:) '(' ((:) '-' + (''$primAppend'' + (showPositiveInt (''$primNegInt'' n)) + (stringFromPacked ")") + )) + ; _ -> showPositiveInt n + } + +showPositiveInt :: Int -> String +showPositiveInt i = + let + rest = quot i 10 + digit = [ (+) '0' (rem i 10) ] + in + case (==) rest 0 of + { True -> digit + ; _ -> ''$primAppend'' (showPositiveInt rest) digit + } + +showList :: (a -> String) -> [a] -> String +showList showElem list = + ''$primConcat'' [ ['['], commaList (''$primMap'' showElem list), [']'] ] + +''$primMap'' f xs = + case xs of + { '':[]'' -> [] + ; (:) y ys -> (:) (f y) (''$primMap'' f ys) + } + +showPolymorphic :: a -> String +showPolymorphic x = + let! x = x in stringFromPacked "<>" + +showTuple2 s1 s2 t : public [custom "type" ["(a -> String) -> (b -> String) -> (a, b) -> String" ]] = + case t of + (@0, 2) x1 x2 -> + showTupleList [ s1 x1, s2 x2 ] + +showTuple3 s1 s2 s3 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (a, b, c) -> String" ]] = + case t of + (@0, 3) x1 x2 x3 -> + showTupleList [ s1 x1, s2 x2, s3 x3 ] + +showTuple4 s1 s2 s3 s4 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (a, b, c, d) -> String" ]] = + case t of + (@0, 4) x1 x2 x3 x4 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4 ] + +showTuple5 s1 s2 s3 s4 s5 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (a, b, c, d, e) -> String" ]] = + case t of + (@0, 5) x1 x2 x3 x4 x5 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5 ] + +showTuple6 s1 s2 s3 s4 s5 s6 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (f -> String) -> (a, b, c, d, e, f) -> String" ]] = + case t of + (@0, 6) x1 x2 x3 x4 x5 x6 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5, s6 x6 ] + +showTuple7 s1 s2 s3 s4 s5 s6 s7 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (f -> String) -> (g -> String) -> (a, b, c, d, e, f, g) -> String" ]] = + case t of + (@0, 7) x1 x2 x3 x4 x5 x6 x7 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5, s6 x6, s7 x7 ] + +showTuple8 s1 s2 s3 s4 s5 s6 s7 s8 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (f -> String) -> (g -> String) -> (h -> String) -> (a, b, c, d, e, f, g, h) -> String" ]] = + case t of + (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5, s6 x6, s7 x7, s8 x8 ] + +showTuple9 s1 s2 s3 s4 s5 s6 s7 s8 s9 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (f -> String) -> (g -> String) -> (h -> String) -> (i -> String) -> (a, b, c, d, e, f, g, h, i) -> String" ]] = + case t of + (@0, 9) x1 x2 x3 x4 x5 x6 x7 x8 x9 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5, s6 x6, s7 x7, s8 x8, s9 x9 ] + +showTuple10 s1 s2 s3 s4 s5 s6 s7 s8 s9 s10 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (f -> String) -> (g -> String) -> (h -> String) -> (i -> String) -> (j -> String) -> (a, b, c, d, e, f, g, h, i, j) -> String" ]]= + case t of + (@0, 10) x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5, s6 x6, s7 x7, s8 x8, s9 x9, s10 x10 ] + +showTupleList :: [String] -> String +showTupleList xs = + ''$primConcat'' [ ['('], commaList xs, [')'] ] + +commaList :: [String] -> String +commaList list = + case list of + { '':[]'' -> [] + ; (:) x xs -> + case xs of + { '':[]'' -> x + ; _ -> ''$primAppend'' x (''$primConcatMap'' (''$primAppend'' [ ',' ]) xs) + } + } + +-- Float + +''$primNegFloat'' :: Float -> Float! +''$primNegFloat'' = negFloat + +''$primStringToFloat'' :: String -> Float +''$primStringToFloat'' = float_of_string_extern + +extern float_of_string_extern "float_of_string" :: "Fz" + +''$primShowFloat'' :: Float -> String +''$primShowFloat'' x = let! x = x in stringFromPacked (stringFromFloat x 6 'g') + +extern stringFromFloat "string_of_float" :: "aFII" + +-- in overloaded version, a negative float is shown as usual (not with "-.") +showFloat : public [custom "type" ["Float -> String"]] + = \f -> addPointZero (''$primShowFloat'' f) + +{- +safeMinus : private [custom "type" ["String -> String"]] + = \s -> + case s of + { (:) x xs -> + case x of + { '-' -> ''$primAppend'' (stringFromPacked "(-.") (''$primAppend'' xs (stringFromPacked ")")) + ; _ -> s + } + ; _ -> s + } +-} + +addPointZero : private [custom "type" ["String -> String"]] + = \s -> + case hasPointOrE s of + { True -> s + ; _ -> ''$primAppend'' s (stringFromPacked ".0") + } + +hasPointOrE : private [] + = \xs -> + case xs of + { [] -> False + ; (:) y ys -> + case y of + { '.' -> True + ; 'e' -> True + ; _ -> hasPointOrE ys + } + } diff --git a/lib/List.hs b/lib/List.hs new file mode 100644 --- /dev/null +++ b/lib/List.hs @@ -0,0 +1,216 @@ +----------------------------------------------------------------------------- +-- Standard Library: List operations +-- +-- Suitable for use with Helium, derived from Hugs 98 Standard Library +-- Modifications: +-- * tuple constructors for zip functions +-- * 'generic' functions for Integral type class are excluded +-- * list functions from Prelude are not exported by this module +----------------------------------------------------------------------------- + +module List where + +import Maybe + +infix 5 \\ + +elemIndex :: Eq a => a -> [a] -> Maybe Int +elemIndex x = findIndex (x ==) + +elemIndices :: Eq a => a -> [a] -> [Int] +elemIndices x = findIndices (x ==) + +find :: (a -> Bool) -> [a] -> Maybe a +find p = listToMaybe . filter p + +findIndex :: (a -> Bool) -> [a] -> Maybe Int +findIndex p = listToMaybe . findIndices p + +findIndices :: (a -> Bool) -> [a] -> [Int] +findIndices p xs = [ i | (x,i) <- zip xs [0..], p x ] + +nub :: (Eq a) => [a] -> [a] +nub = nubBy (==) + +nubBy :: (a -> a -> Bool) -> [a] -> [a] +nubBy eq [] = [] +nubBy eq (x:xs) = x : nubBy eq (filter (\y -> not (eq x y)) xs) + +delete :: (Eq a) => a -> [a] -> [a] +delete = deleteBy (==) + +deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] +deleteBy eq x [] = [] +deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys + +(\\) :: (Eq a) => [a] -> [a] -> [a] +(\\) = foldl (flip delete) + +deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] +deleteFirstsBy eq = foldl (flip (deleteBy eq)) + +union :: (Eq a) => [a] -> [a] -> [a] +union = unionBy (==) + +unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] +unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs + +intersect :: (Eq a) => [a] -> [a] -> [a] +intersect = intersectBy (==) + +intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] +intersectBy eq xs ys = [x | x <- xs, any (eq x) ys] + +intersperse :: a -> [a] -> [a] +intersperse sep [] = [] +intersperse sep [x] = [x] +intersperse sep (x:xs) = x : sep : intersperse sep xs + +transpose :: [[a]] -> [[a]] +transpose [] = [] +transpose ([] : xss) = transpose xss +transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : + transpose (xs : [ t | (h:t) <- xss]) + +partition :: (a -> Bool) -> [a] -> ([a],[a]) +partition p xs = foldr select ([],[]) xs + where select x (ts,fs) | p x = (x:ts,fs) + | otherwise = (ts,x:fs) + +-- group splits its list argument into a list of lists of equal, adjacent +-- elements. e.g., +-- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"] +group :: (Eq a) => [a] -> [[a]] +group = groupBy (==) + +groupBy :: (a -> a -> Bool) -> [a] -> [[a]] +groupBy eq [] = [] +groupBy eq (x:xs) = (x:ys) : groupBy eq zs + where (ys,zs) = span (eq x) xs + +-- inits xs returns the list of initial segments of xs, shortest first. +-- e.g., inits "abc" == ["","a","ab","abc"] +inits :: [a] -> [[a]] +inits [] = [[]] +inits (x:xs) = [[]] ++ map (x:) (inits xs) + +-- tails xs returns the list of all final segments of xs, longest first. +-- e.g., tails "abc" == ["abc", "bc", "c",""] +tails :: [a] -> [[a]] +tails [] = [[]] +tails xxs@(_:xs) = xxs : tails xs + +isPrefixOf :: (Eq a) => [a] -> [a] -> Bool +isPrefixOf [] _ = True +isPrefixOf _ [] = False +isPrefixOf (x:xs) (y:ys) = x == y && isPrefixOf xs ys + +isSuffixOf :: (Eq a) => [a] -> [a] -> Bool +isSuffixOf x y = reverse x `isPrefixOf` reverse y + +mapAccumL :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c]) +mapAccumL f s [] = (s, []) +mapAccumL f s (x:xs) = (s'',y:ys) + where (s', y ) = f s x + (s'',ys) = mapAccumL f s' xs + +mapAccumR :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c]) +mapAccumR f s [] = (s, []) +mapAccumR f s (x:xs) = (s'', y:ys) + where (s'',y ) = f s' x + (s', ys) = mapAccumR f s xs + +unfoldr :: (b -> Maybe (a,b)) -> b -> [a] +unfoldr f b = case f b of Nothing -> [] + Just (a,b) -> a : unfoldr f b + +sort :: (Ord a) => [a] -> [a] +sort = sortBy compare + +sortBy :: (a -> a -> Ordering) -> [a] -> [a] +sortBy cmp = foldr (insertBy cmp) [] + +insert :: (Ord a) => a -> [a] -> [a] +insert = insertBy compare + +insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a] +insertBy cmp x [] = [x] +insertBy cmp x ys@(y:ys') + = case cmp x y of + GT -> y : insertBy cmp x ys' + _ -> x : ys + +maximumBy :: (a -> a -> Ordering) -> [a] -> a +maximumBy cmp [] = error "List.maximumBy: empty list" +maximumBy cmp xs = foldl1 max xs + where + max x y = case cmp x y of + GT -> x + _ -> y + +minimumBy :: (a -> a -> Ordering) -> [a] -> a +minimumBy cmp [] = error "List.minimumBy: empty list" +minimumBy cmp xs = foldl1 min xs + where + min x y = case cmp x y of + GT -> y + _ -> x + +zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)] +zip4 = zipWith4 (\a b c d -> (a, b, c, d)) + +zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)] +zip5 = zipWith5 (\a b c d e -> (a, b, c, d, e)) + +zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> + [(a,b,c,d,e,f)] +zip6 = zipWith6 (\a b c d e f -> (a, b, c, d, e, f)) + +zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> + [g] -> [(a,b,c,d,e,f,g)] +zip7 = zipWith7 (\a b c d e f g -> (a, b, c, d, e, f, g)) + +zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] +zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) + = z a b c d : zipWith4 z as bs cs ds +zipWith4 _ _ _ _ _ = [] + +zipWith5 :: (a->b->c->d->e->f) -> + [a]->[b]->[c]->[d]->[e]->[f] +zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) + = z a b c d e : zipWith5 z as bs cs ds es +zipWith5 _ _ _ _ _ _ = [] + +zipWith6 :: (a->b->c->d->e->f->g) -> + [a]->[b]->[c]->[d]->[e]->[f]->[g] +zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) + = z a b c d e f : zipWith6 z as bs cs ds es fs +zipWith6 _ _ _ _ _ _ _ = [] + +zipWith7 :: (a->b->c->d->e->f->g->h) -> + [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h] +zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) + = z a b c d e f g : zipWith7 z as bs cs ds es fs gs +zipWith7 _ _ _ _ _ _ _ _ = [] + +unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d]) +unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) -> + (a:as,b:bs,c:cs,d:ds)) + ([],[],[],[]) + +unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e]) +unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) -> + (a:as,b:bs,c:cs,d:ds,e:es)) + ([],[],[],[],[]) + +unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f]) +unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) -> + (a:as,b:bs,c:cs,d:ds,e:es,f:fs)) + ([],[],[],[],[],[]) + +unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g]) +unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) -> + (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs)) + ([],[],[],[],[],[],[]) + +----------------------------------------------------------------------------- diff --git a/lib/LvmException.core b/lib/LvmException.core new file mode 100644 --- /dev/null +++ b/lib/LvmException.core @@ -0,0 +1,123 @@ +---------------------------------------------------------------- +-- Daan Leijen (c) 2001 +-- +-- $Revision: 252 $ +-- $Author: uust $ +-- $Date: 2004-01-14 16:47:22 +0100 (Wed, 14 Jan 2004) $ +---------------------------------------------------------------- +module LvmException( Exception(..), RuntimeException(..), SystemException(..) + , ArithmeticException(..), SignalException(..) + , catch, raise, error, errorPacked, patternFail, patternFailPacked + ) where + +import LvmLang( packedFromString ) + +instruction primCatch "catch" :: (Exception -> a) -> a -> a +instruction primRaise "raise" :: Exception! -> a + + +{---------------------------------------------------------- + Exception and Signals +----------------------------------------------------------} +data Exception + = HeapOverflow -- heap overflow + | StackOverflow Int -- stack overflow + | Signal SignalException -- interrupt occurred + | Runtime RuntimeException -- runtime system exception + | Arithmetic ArithmeticException -- arithmetic exception + | System SystemException -- operating system exceptions + | InvalidArgument PackedString -- invalid argument passed + | Assert PackedString -- assertion failed + | NotFound -- no object is found + | UserError PackedString -- general failure (raised by "error") + +data RuntimeException + = PatternFailure PackedString -- pattern match failure + | NonTermination PackedString -- non terminating program + | OutOfBounds PackedString -- field access out of bounds + | Exit Int -- exiting program + | InvalidOpcode Int -- invalid opcode + | LoadError PackedString PackedString -- runtime loader exception + | RuntimeError PackedString -- general failure + +data SystemException + = EndOfFile -- end of input reached + | BlockedOnIO -- blocked I/O channel + | SystemError Int PackedString -- general system error + +data ArithmeticException + = FloatInvalid -- float invalid operation + | FloatDivideByZero -- float division by zero + | FloatOverflow -- float has overflowed + | FloatUnderflow -- float has underflowed + | FloatInexact -- float result is inexact + | FloatDenormal -- denormalized float value + | DivideByZero -- integer division by zero + | Overflow -- integer overflow + | Underflow -- integer underflow + | InvalidOperation -- general arithmetic error + | UnEmulated -- cannot emulate float instruction + | NegativeSquareRoot -- square root of negative number + | FloatStackOverflow -- float hardware stack has overflowed + | FloatStackUnderflow -- float hardware stack has underflowed + +data SignalException + = SignalNone -- runtime: no signal + | SignalGarbageCollect -- runtime: GC needed + | SignalYield -- runtime: thread should yield + | SignalLost -- runtime: lost signal + | SignalKeyboard -- interactive interrupt (ctrl-c) + | SignalKeyboardStop -- interactive stop (ctrl-break) + | SignalFloatException -- floating point exception + | SignalSegmentationViolation -- invalid memory reference + | SignalIllegalInstruction -- illegal hardware instruction + | SignalAbort -- abnormal termination + | SignalTerminate -- termination + | SignalKill -- termination (can not be ignored) + | SignalKeyboardTerminate -- interactive termination + | SignalAlarm -- timeout + | SignalVirtualAlarm -- timeout in virtual time + | SignalBackgroundRead -- terminal read from background process + | SignalBackgroundWrite -- terminal write from background process + | SignalContinue -- continue process + | SignalLostConnection -- connection lost + | SignalBrokenPipe -- open ended pipe + | SignalProcessStatusChanged -- child process terminated + | SignalStop -- stop process + | SignalProfiler -- profiling interrupt + | SignalUser1 -- application defined signal 1 + | SignalUser2 -- application defined signal 2 + + +{---------------------------------------------------------- + raise and catch +----------------------------------------------------------} +raise :: Exception -> a +raise exn + = let! exn = exn in primRaise exn + +catch :: IO a -> (Exception -> IO a) -> IO a +catch action handler + = \_ -> primCatch (\exn -> handler exn ()) (action ()) + +{---------------------------------------------------------- + user errors +----------------------------------------------------------} +error :: String -> a +error msg + = let! s = (packedFromString msg) in raise (UserError s) + +errorPacked :: PackedString -> a +errorPacked msg + = raise (UserError msg) + +patternFail :: String -> a +patternFail msg + = let! s = packedFromString msg + exn = PatternFailure s + in raise (Runtime exn) + +patternFailPacked :: PackedString -> a +patternFailPacked msg + = let! exn = PatternFailure msg + in raise (Runtime exn) diff --git a/lib/LvmIO.core b/lib/LvmIO.core new file mode 100644 --- /dev/null +++ b/lib/LvmIO.core @@ -0,0 +1,160 @@ +---------------------------------------------------------------- +-- Daan Leijen (c) 2001 +-- +-- $Revision: 285 $ +-- $Author: uust $ +-- $Date: 2004-02-14 15:46:23 +0100 (Sat, 14 Feb 2004) $ +---------------------------------------------------------------- +module LvmIO( Input, Output, Channel, Descriptor + , stdin, stdout, stderr + , flush, close + , outputChar, outputPacked, outputString + , inputChar + , CreateMode(..), openInputFile, openOutputFile + ) where + +import LvmLang( primIO, packedLength, packedFromString, bindIO, unsafePerformStrictIO, False, True ) + +{---------------------------------------------------------- + Primitive I/O operations +----------------------------------------------------------} +extern prim_open :: "IzII" +extern prim_close :: "vI" +extern prim_flag_mask :: "II" +extern prim_input_flags :: "II" +extern prim_output_flags :: "III" + +extern prim_open_descriptor :: "aIb" +extern prim_close_channel :: "va" +extern prim_set_binary_mode :: "vab" +extern prim_flush_partial :: "ba" +extern prim_flush :: "va" +extern prim_output_char :: "vac" +extern prim_output :: "vazll" +extern prim_input_char :: "Ia" + + +{---------------------------------------------------------- + Channels +----------------------------------------------------------} +data Input +data Output +data Channel a +type Descriptor = Int + + +{---------------------------------------------------------- + Private helpers +----------------------------------------------------------} +primOpenInputDescriptor :: Descriptor -> Channel Input +primOpenInputDescriptor fd + = let! fd = fd in prim_open_descriptor fd False + +primOpenOutputDescriptor :: Descriptor -> Channel Output +primOpenOutputDescriptor fd + = let! fd = fd in prim_open_descriptor fd True + + +{---------------------------------------------------------- + Files +----------------------------------------------------------} +data CreateMode + = CreateNever -- don't create a new file, and append writes + | CreateIfNotExists -- create one if none exists yet, append otherwise + | CreateExclusive -- create if none exists, but fail if a file exists + | CreateOverwrite -- destroy previous file, and create a new one + +{---------------------------------------------------------- + Private file operations +----------------------------------------------------------} +data OpenFlag + = OpenReadOnly + | OpenWriteOnly + | OpenCreate + | OpenTruncate + | OpenExclusive + | OpenBinary + | OpenText + | OpenNonBlocking + +primOpenInputFile :: FilePath -> Bool -> Channel Input +primOpenInputFile fpath asText + = let! b = asText + m = prim_input_flags b + fname = packedFromString fpath + fd = prim_open fname m 0o744 + in primOpenInputDescriptor fd + +primOpenOutputFile :: FilePath -> Bool -> CreateMode -> Channel Output +primOpenOutputFile fpath asText cmode + = let! b = asText + c = cmode + m = prim_output_flags b c + fname = packedFromString fpath + fd = prim_open fname m 0o744 + in primOpenOutputDescriptor fd + + +{---------------------------------------------------------- + Channel I/O, based on the OCaml interface +----------------------------------------------------------} +stdin :: Channel Input +stdin + = primOpenInputDescriptor 0 + +stdout :: Channel Output +stdout + = primOpenOutputDescriptor 1 + +stderr :: Channel Output +stderr + = primOpenOutputDescriptor 2 + +openInputFile :: FilePath -> Bool -> IO (Channel Input) +openInputFile fpath asText + = let action _ = primOpenInputFile fpath asText + in primIO action + +openOutputFile :: FilePath -> Bool -> CreateMode -> IO (Channel Output) +openOutputFile fpath asText createMode + = let action _ = primOpenOutputFile fpath asText createMode + in primIO action + +{-------------------------------------------------------------------------- + Channel operations +--------------------------------------------------------------------------} +flush :: Channel Output -> IO () +flush out + = let action _ = (let! out = out in prim_flush out) + in primIO action + +close :: Channel a -> IO () +close chan + = let action _ = (let! chan = chan in prim_close_channel chan) + in primIO action + +outputChar :: Channel Output -> Char -> IO () +outputChar out c + = let action _ = let! out = out + c = c + in prim_output_char out c + in primIO action + +inputChar :: Channel Input -> IO Char +inputChar inp + = let action _ = let! inp = inp in prim_input_char inp + in primIO action + + +outputPacked :: Channel Output -> PackedString -> IO () +outputPacked chan s + = let action _ = let! chan = chan + s = s + len = packedLength s + in prim_output chan s 0 len + in primIO action + +-- TODO: use direct I/O primitive for strings +outputString :: Channel Output -> String -> IO () +outputString chan s + = outputPacked chan (packedFromString s) diff --git a/lib/LvmLang.core b/lib/LvmLang.core new file mode 100644 --- /dev/null +++ b/lib/LvmLang.core @@ -0,0 +1,327 @@ +---------------------------------------------------------------- +-- Daan Leijen (c) 2001 +-- +-- $Revision: 285 $ +-- $Author: uust $ +-- $Date: 2004-02-14 15:46:23 +0100 (Sat, 14 Feb 2004) $ +---------------------------------------------------------------- +module LvmLang + ( Bytes, Int, Float + , Bool(True, False), '':[]''('':[]'', (:)), '':()''('':()'') + , IO, Char, Double, PackedString, String + + , packedFromString, stringFromPacked, packedLength + , ($!), seq + + -- IO + , bindIO, returnIO + , primIO, unsafePerformIO, unsafePerformStrictIO + + -- Int + , (+), (-), (*), (/), (%), quot, rem + , and, xor, or, shr, shl, shrNat, negInt + , (==), (/=), (<), (>), (<=), (>=) + + -- Float + , (+.), (-.), (*.), (/.), negFloat + , (==.), (/=.), (<.), (>.), (<=.), (>=.) + + ) where + +{---------------------------------------------------------- + Instructions +----------------------------------------------------------} +instruction primAddInt "addint" :: Int! -> Int! -> Int! +instruction primSubInt "subint" :: Int! -> Int! -> Int! +instruction primMulInt "mulint" :: Int! -> Int! -> Int! +instruction primDivInt "divint" :: Int! -> Int! -> Int! +instruction primModInt "modint" :: Int! -> Int! -> Int! +instruction primQuotInt "quotint":: Int! -> Int! -> Int! +instruction primRemInt "remint" :: Int! -> Int! -> Int! +instruction primAndInt "andint" :: Int! -> Int! -> Int! +instruction primXorInt "xorint" :: Int! -> Int! -> Int! +instruction primOrInt "orint" :: Int! -> Int! -> Int! +instruction primShrInt "shrint" :: Int! -> Int! -> Int! +instruction primShlInt "shlint" :: Int! -> Int! -> Int! +instruction primShrNat "shrnat" :: Int! -> Int! -> Int! +instruction primNegInt "negint" :: Int! -> Int! + +instruction primEqInt "eqint" :: Int! -> Int! -> Bool! +instruction primNeInt "neint" :: Int! -> Int! -> Bool! +instruction primLtInt "ltint" :: Int! -> Int! -> Bool! +instruction primGtInt "gtint" :: Int! -> Int! -> Bool! +instruction primLeInt "leint" :: Int! -> Int! -> Bool! +instruction primGeInt "geint" :: Int! -> Int! -> Bool! + +instruction primAddFloat "addfloat" :: Float! -> Float! -> Float! +instruction primSubFloat "subfloat" :: Float! -> Float! -> Float! +instruction primMulFloat "mulfloat" :: Float! -> Float! -> Float! +instruction primDivFloat "divfloat" :: Float! -> Float! -> Float! +instruction primNegFloat "negfloat" :: Float! -> Float! + +instruction primEqFloat "eqfloat" :: Float! -> Float! -> Bool! +instruction primNeFloat "nefloat" :: Float! -> Float! -> Bool! +instruction primLtFloat "ltfloat" :: Float! -> Float! -> Bool! +instruction primGtFloat "gtfloat" :: Float! -> Float! -> Bool! +instruction primLeFloat "lefloat" :: Float! -> Float! -> Bool! +instruction primGeFloat "gefloat" :: Float! -> Float! -> Bool! + +instruction primAlloc "alloc" :: Int! {- tag -} -> Int! {- size -} -> a! +instruction primGetTag "gettag" :: a! -> Int! +instruction primGetSize "getsize":: a! -> Int! +-- instruction primNew "new" :: Int! {- tag -} -> Int! {- size -} -> {- x_1 ... x_n -> -} a! +-- instruction primPack "pack" :: a! -> Int! {- size -} -> {- x_1 ... x_size -} () +-- instruction primUnPack "unpack" :: a! -> (# x_1 ... x_size #) + +extern prim_chars_of_string :: "aa" +extern prim_string_of_chars :: "ala" +extern prim_string_length :: "la" + +{---------------------------------------------------------- + Basic data types +----------------------------------------------------------} +data Bytes +data Int +data Float +data Bool = False -- tag 0 + | True -- tag 1 + +{- +Be aware that de definition +data Bool = True -- tag 0 + | False -- tag 1 +is not allowed because the instructions +eqint, neint etc. assume False has tag 0 +and True has tag 1. +-} + +data '':[]'' a = '':[]'' | (:) a [a] +data '':()'' = '':()'' + +data IORes a = IORes a +data IO a -- = () -> IORes a + +{---------------------------------------------------------- + Type definitions +----------------------------------------------------------} +type Char = Int +type Double = Float + +type PackedString = Bytes +type String = [Char] + + +{---------------------------------------------------------- + Strictness +----------------------------------------------------------} +($!) :: (a -> b) -> a -> b +($!) f x = let! x = x in f x + +seq :: a -> b -> b +seq x y = let! x = x in y + +{---------------------------------------------------------- + Basic arithmetic on Int's +----------------------------------------------------------} +(+) :: Int -> Int -> Int! +(+) x y = let! y = y in let! x = x in primAddInt x y + +(-) :: Int -> Int -> Int! +(-) x y = let! y = y in let! x = x in primSubInt x y + +(*) :: Int -> Int -> Int! +(*) x y = let! y = y in let! x = x in primMulInt x y + +(/) :: Int -> Int -> Int! +(/) x y = let! y = y in let! x = x in primDivInt x y + +(%) :: Int -> Int -> Int! +(%) x y = let! y = y in let! x = x in primModInt x y + +quot :: Int -> Int -> Int! +quot x y = let! y = y in let! x = x in primQuotInt x y + +rem :: Int -> Int -> Int! +rem x y = let! y = y in let! x = x in primRemInt x y + +and :: Int -> Int -> Int! +and x y = let! y = y in let! x = x in primAndInt x y + +xor :: Int -> Int -> Int! +xor x y = let! y = y in let! x = x in primXorInt x y + +or :: Int -> Int -> Int! +or x y = let! y = y in let! x = x in primOrInt x y + +shr :: Int -> Int -> Int! +shr x y = let! y = y in let! x = x in primShrInt x y + +shl :: Int -> Int -> Int! +shl x y = let! y = y in let! x = x in primShlInt x y + +shrNat :: Int -> Int -> Int! +shrNat x y = let! y = y in let! x = x in primShrNat x y + +negInt :: Int -> Int! +negInt x = let! x = x in primNegInt x + +{---------------------------------------------------------- + Comparisons on Int's +----------------------------------------------------------} +(==) :: Int -> Int -> Bool! +(==) x y = let! y = y in let! x = x in primEqInt x y + +(/=) :: Int -> Int -> Bool! +(/=) x y = let! y = y in let! x = x in primNeInt x y + +(<) :: Int -> Int -> Bool! +(<) x y = let! y = y in let! x = x in primLtInt x y + +(>) :: Int -> Int -> Bool! +(>) x y = let! y = y in let! x = x in primGtInt x y + +(<=) :: Int -> Int -> Bool! +(<=) x y = let! y = y in let! x = x in primLeInt x y + +(>=) :: Int -> Int -> Bool! +(>=) x y = let! y = y in let! x = x in primGeInt x y + +{---------------------------------------------------------- + Basic arithmetic on Float's +----------------------------------------------------------} +(+.) :: Float -> Float -> Float! +(+.) x y = let! y = y in let! x = x in primAddFloat x y + +(-.) :: Float -> Float -> Float! +(-.) x y = let! y = y in let! x = x in primSubFloat x y + +(*.) :: Float -> Float -> Float! +(*.) x y = let! y = y in let! x = x in primMulFloat x y + +(/.) :: Float -> Float -> Float! +(/.) x y = let! y = y in let! x = x in primDivFloat x y + +negFloat :: Float -> Float! +negFloat x = let! x = x in primNegFloat x + +{---------------------------------------------------------- + Comparisons on Float's +----------------------------------------------------------} +(==.) :: Float -> Float -> Bool! +(==.) x y = let! y = y in let! x = x in primEqFloat x y + +(/=.) :: Float -> Float -> Bool! +(/=.) x y = let! y = y in let! x = x in primNeFloat x y + +(<.) :: Float -> Float -> Bool! +(<.) x y = let! y = y in let! x = x in primLtFloat x y + +(>.) :: Float -> Float -> Bool! +(>.) x y = let! y = y in let! x = x in primGtFloat x y + +(<=.) :: Float -> Float -> Bool! +(<=.) x y = let! y = y in let! x = x in primLeFloat x y + +(>=.) :: Float -> Float -> Bool! +(>=.) x y = let! y = y in let! x = x in primGeFloat x y + +{---------------------------------------------------------- + Boolean expressions +----------------------------------------------------------} +(&&) :: Bool -> Bool -> Bool +(&&) x y + = case x of + False -> False + True -> y + + +(||) :: Bool -> Bool -> Bool +(||) x y + = case x of + True -> True + False -> y + +not :: Bool -> Bool +not x + = case x of + True -> False + False -> True + +{---------------------------------------------------------- + Packed strings +----------------------------------------------------------} +stringFromPacked :: PackedString -> String +stringFromPacked packed + = let! packed = packed in prim_chars_of_string packed + +packedFromString :: String -> PackedString +packedFromString s + = let forced s = case s of + [] -> [] + (:) x xs -> let! y = x + ys = forced xs + in (:) y ys + length n s = case s of + [] -> n + (:) x xs -> let! m = (+) n 1 + in length m xs + in let! fs = forced s + len = length 0 fs + in prim_string_of_chars len fs + + + {- + let forceLength n xs = case xs of + (:) x xx -> seq x (forceLength ((+) n 1) xx) + [] -> n + in let! len = forceLength 0 s + t = s + in prim_string_of_chars len t + -} + +packedLength :: PackedString -> Int +packedLength s + = let! s = s in prim_string_length s + +{---------------------------------------------------------- + List helpers +----------------------------------------------------------} +{- +length :: [a] -> Int +length xs + = foldlStrict (+) 0 xs + +foldlStrict :: (b -> a -> b) -> b -> [a] -> b +foldlStrict f z xs + = case xs of + (:) x xx -> case f z x of + z -> foldlStrict f z xx + [] -> z +-} + + +{---------------------------------------------------------- + The IO monad +----------------------------------------------------------} +bindIO :: IO a -> (a -> IO b) -> IO b +bindIO io f + = \_ -> case io () of + IORes x -> f x () + +returnIO :: a -> IO a +returnIO x + = \_ -> IORes x + +primIO :: (() -> a) -> IO a +primIO f + = \_ -> let! x = f () in IORes x + +unsafePerformIO :: IO a -> a +unsafePerformIO io + = case io () of + IORes x -> x + +-- used to execute "main" +unsafePerformStrictIO :: IO a -> a +unsafePerformStrictIO io + = let! x = unsafePerformIO io in x diff --git a/lib/Makefile b/lib/Makefile new file mode 100644 --- /dev/null +++ b/lib/Makefile @@ -0,0 +1,24 @@ + +COREASM=coreasm +HELIUM=helium + +.PHONY : all +.SUFFIXES : .core .lvm .o + +CORESRC = LvmLang.core LvmIO.core LvmException.core \ + HeliumLang.core PreludePrim.core + +HELIUMSRC = Prelude.hs List.hs Maybe.hs Char.hs + +LIBRARIES = $(patsubst %.core,%.lvm,$(CORESRC)) \ + $(patsubst %.hs,%.o,$(HELIUMSRC)) + +all : $(LIBRARIES) + echo $(LIBRARIES) + +%.lvm : %.core + $(COREASM) $< + +%.o : %.hs + "$(HELIUM)" -b --overloading $< + diff --git a/lib/Maybe.hs b/lib/Maybe.hs new file mode 100644 --- /dev/null +++ b/lib/Maybe.hs @@ -0,0 +1,39 @@ +----------------------------------------------------------------------------- +-- Standard Library: Operations on the Maybe datatype +-- +-- Suitable for use with Helium (with overloading) +----------------------------------------------------------------------------- + +module Maybe where + +isJust :: Maybe a -> Bool +isJust (Just _) = True +isJust Nothing = False + +isNothing :: Maybe a -> Bool +isNothing Nothing = True +isNothing (Just _) = False + +fromJust :: Maybe a -> a +fromJust (Just a) = a +fromJust Nothing = error "Maybe.fromJust: Nothing" + +fromMaybe :: a -> Maybe a -> a +fromMaybe d Nothing = d +fromMaybe _ (Just a) = a + +maybeToList :: Maybe a -> [a] +maybeToList Nothing = [] +maybeToList (Just a) = [a] + +listToMaybe :: [a] -> Maybe a +listToMaybe [] = Nothing +listToMaybe (a:_) = Just a + +catMaybes :: [Maybe a] -> [a] +catMaybes ms = [ m | Just m <- ms ] + +mapMaybe :: (a -> Maybe b) -> [a] -> [b] +mapMaybe f = catMaybes . map f + +----------------------------------------------------------------------------- diff --git a/lib/Prelude.hs b/lib/Prelude.hs new file mode 100644 --- /dev/null +++ b/lib/Prelude.hs @@ -0,0 +1,642 @@ +{- The overloaded Standard Prelude for the Helium Compiler -} + +module Prelude where + +import PreludePrim + +infixr 9 . +infixl 9 !! +infixr 8 ^ -- , **. +-- infixl 7 *, `quot`, `rem`, `div`, `mod`, / [PreludePrim] +-- infixl 6 +, - [PreludePrim] +infixr 5 ++ +-- infixr 5 : [HeliumLang] +-- infix 4 ==, /=, <=, <, >, >= [PreludePrim] +infixr 3 && +infixr 2 || +infixr 0 $ --, $! [PreludePrim] + +{----------------------------------------------- + -- Num + -----------------------------------------------} + +{- imported from PreludePrim + +(+) :: Num a => a -> a -> a +(-) :: Num a => a -> a -> a +(*) :: Num a => a -> a -> a +negate :: Num a => a -> a +fromInt :: Num a => Int -> a +-} + +sum :: Num a => [a] -> a +sum = foldl' (+) (fromInt 0) + +product :: Num a => [a] -> a +product = foldl' (*) (fromInt 1) + +{----------------------------------------------- + -- Eq + -----------------------------------------------} + +{- imported from PreludePrim + +(==) :: Eq a => a -> a -> Bool +(/=) :: Eq a => a -> a -> Bool +-} + +elem :: Eq a => a -> [a] -> Bool +elem _ [] = False +elem x (y:ys) + | x == y = True + | otherwise = elem x ys + +notElem :: Eq a => a -> [a] -> Bool +notElem x ys = not (x `elem` ys) + +lookup :: Eq a => a -> [(a,b)] -> Maybe b +lookup _ [] = Nothing +lookup k ((x,y):xys) + | k == x = Just y + | otherwise = lookup k xys + +{----------------------------------------------- + -- Ord + -----------------------------------------------} + +{- imported from PreludePrim + +(<) :: Ord a => a -> a -> Bool +(<=) :: Ord a => a -> a -> Bool +(>) :: Ord a => a -> a -> Bool +(>=) :: Ord a => a -> a -> Bool +compare :: Ord a => a -> a -> Ordering +-} + +max :: Ord a => a -> a -> a +max x y = if x < y then y else x + +min :: Ord a => a -> a -> a +min x y = if x < y then x else y + +maximum :: Ord a => [a] -> a +maximum = foldl1 max + +minimum :: Ord a => [a] -> a +minimum = foldl1 min + +{----------------------------------------------- + -- Enum + -----------------------------------------------} + +{- imported from PreludePrim + +succ :: Enum a => a -> a +pred :: Enum a => a -> a +enumFromTo :: Enum a => a -> a -> [a] +enumFromThenTo :: Enum a => a -> a -> a -> [a] +toEnum :: Enum a => Int -> a +fromEnum :: Enum a => a -> Int +enumFrom :: Enum a => a -> [a] +enumFromThen :: Enum a => a -> a -> [a] +-} + +{----------------------------------------------- + -- Int + -----------------------------------------------} + +{- imported from PreludePrim +rem :: Int -> Int -> Int +div :: Int -> Int -> Int +mod :: Int -> Int -> Int +quot :: Int -> Int -> Int +-} + +-- for compatibility with Haskell textbooks +type Integer = Int + +abs :: Int -> Int +abs x = if x < 0 then - x else x + +signum :: Int -> Int +signum x = + case compare x 0 of + LT -> -1 + EQ -> 0 + GT -> 1 + +even :: Int -> Bool +even n = n `rem` 2 == 0 + +odd :: Int -> Bool +odd n = not (even n) + +subtract :: Int -> Int -> Int +subtract a b = b - a + +gcd :: Int -> Int -> Int +gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined" +gcd x y = gcd' (abs x) (abs y) + where gcd' :: Int -> Int -> Int + gcd' x' 0 = x' + gcd' x' y' = gcd' y' (x' `rem` y') + +lcm :: Int -> Int -> Int +lcm _ 0 = 0 +lcm 0 _ = 0 +lcm x y = abs ((x `quot` gcd x y) * y) + +(^) :: Num a => a -> Int -> a +_ ^ 0 = fromInt 1 +i ^ n | n > 0 = f i (n-1) i + | otherwise = error "Prelude.^: negative exponent" + where f _ 0 y = y + f x m y = g x m + where g x' m' | even m' = g (x' * x') (m' `quot` 2) + | otherwise = f x' (m' - 1) (x' * y) + +{----------------------------------------------- + -- Float + -----------------------------------------------} + +{- imported from PreludePrim + +(/) :: Float -> Float -> Float +sqrt :: Float -> Float +(**.) :: Float -> Float -> Float +exp :: Float -> Float +log :: Float -> Float +sin :: Float -> Float +cos :: Float -> Float +tan :: Float -> Float +-} + +absFloat :: Float -> Float +absFloat x = if x < 0.0 then (-. x) else x + +signumFloat :: Float -> Int +signumFloat x = + case compare x 0.0 of + LT -> -1 + EQ -> 0 + GT -> 1 + +pi :: Float +pi = 3.141592653589793 + +{----------------------------------------------- + -- Bool + -----------------------------------------------} + +not :: Bool -> Bool +not False = True +not _ = False + +(||) :: Bool -> Bool -> Bool +(&&) :: Bool -> Bool -> Bool + +x || y = if x then x else y +x && y = if x then y else x + +otherwise :: Bool +otherwise = True + +{----------------------------------------------- + -- Maybe + -----------------------------------------------} + +data Maybe a + = Nothing + | Just a + deriving (Eq, Show) + +maybe :: b -> (a -> b) -> Maybe a -> b +maybe e f m = + case m of + Nothing -> e + Just x -> f x + +{----------------------------------------------- + -- Either + -----------------------------------------------} + +data Either a b = Left a | Right b deriving (Eq, Show) + +either :: (a -> c) -> (b -> c) -> Either a b -> c +either l r e = + case e of + Left x -> l x + Right y -> r y + +{----------------------------------------------- + -- Ordering + -----------------------------------------------} + +{- imported from PreludePrim + +data Ordering = LT | EQ | GT +-} + +{----------------------------------------------- + -- Tuple + -----------------------------------------------} + +fst :: (a, b) -> a +fst (x, _) = x + +snd :: (a, b) -> b +snd (_, x) = x + +curry :: ((a,b) -> c) -> (a -> b -> c) +curry f x y = f (x,y) + +uncurry :: (a -> b -> c) -> ((a,b) -> c) +uncurry f p = f (fst p) (snd p) + +zip :: [a] -> [b] -> [(a,b)] +zip = zipWith (\a b -> (a,b)) + +zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] +zip3 = zipWith3 (\a b c -> (a,b,c)) + +zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] +zipWith z (a:as) (b:bs) = z a b : zipWith z as bs +zipWith _ _ _ = [] + +zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] +zipWith3 z (a:as) (b:bs) (c:cs) + = z a b c : zipWith3 z as bs cs +zipWith3 _ _ _ _ = [] + +unzip :: [(a,b)] -> ([a],[b]) +unzip = foldr (\(a,b) (as,bs) -> (a:as, b:bs)) ([], []) + +unzip3:: [(a,b,c)] -> ([a],[b],[c]) +unzip3 = foldr (\(a,b,c) (as,bs,cs) -> (a:as,b:bs,c:cs)) ([],[],[]) + +{----------------------------------------------- + -- List + -----------------------------------------------} + +-- We can't import Char here because that would mean we couldn't import +-- it elsewhere. Therefore, we make local copies of the two functions +-- from that module +localIsSpace :: Char -> Bool +localIsSpace c = + i == primOrd ' ' || i == primOrd '\t' || i == primOrd '\n' || + i == primOrd '\r' || i == primOrd '\f' || i == primOrd '\v' + where + i = primOrd c + +localIsDigit :: Char -> Bool +localIsDigit c = primOrd c >= primOrd '0' && primOrd c <= primOrd '9' + +{----------------------------------------------- + -- List + -----------------------------------------------} + +head :: [a] -> a +head (x:_) = x +head _ = error "Prelude.head: empty list" + +last :: [a] -> a +last [x] = x +last (_:xs) = last xs +last _ = error "Prelude.last: empty list" + +tail :: [a] -> [a] +tail (_:xs) = xs +tail _ = error "Prelude.tail: empty list" + +init :: [a] -> [a] +init [_] = [] +init (x:xs) = x : init xs +init _ = error "Prelude.init: empty list" + +null :: [a] -> Bool +null [] = True +null _ = False + +(++) :: [a] -> [a] -> [a] +(x:xs) ++ ys = x : (xs ++ ys) +[] ++ ys = ys + +map :: (a -> b) -> [a] -> [b] +map _ [] = [] +map f (x:xs) = f x : map f xs + +filter :: (a -> Bool) -> [a] -> [a] +filter p (x:xs) + | p x = x : filter p xs + | otherwise = filter p xs +filter _ [] = [] + +{- +Naive implementation of length (slow because of laziness) + +length :: [a] -> Int +length [] = 0 +length (_:xs) = 1 + length xs + +Optimised implementation using strict foldl: +-} + +length :: [a] -> Int +length xs = foldl' (\l _ -> l + 1) 0 xs + +concat :: [[a]] -> [a] +concat = foldr (++) [] + +(!!) :: [a] -> Int -> a +xs !! n | n < 0 = error "Prelude.(!!): negative index" + | null xs = error "Prelude.(!!): index too large" + | n == 0 = head xs + | otherwise = tail xs !! (n - 1) + +foldl :: (a -> b -> a) -> a -> [b] -> a +foldl _ z [] = z +foldl f z (x:xs) = foldl f (f z x) xs + +foldl' :: (a -> b -> a) -> a -> [b] -> a +foldl' _ a [] = a +foldl' f a (x:xs) = (foldl' f $! f a x) xs + +foldl1 :: (a -> a -> a) -> [a] -> a +foldl1 f (x:xs) = foldl f x xs +foldl1 _ [] = error "Prelude.foldl1: empty list" + +scanl :: (a -> b -> a) -> a -> [b] -> [a] +scanl f q xs = q : + ( case xs of + [] -> [] + y:ys -> scanl f (f q y) ys + ) + +scanl1 :: (a -> a -> a) -> [a] -> [a] +scanl1 _ [] = [] +scanl1 f (x:xs) = scanl f x xs + +foldr :: (a -> b -> b) -> b -> [a] -> b +foldr _ z [] = z +foldr f z (x:xs) = f x (foldr f z xs) + +foldr1 :: (a -> a -> a) -> [a] -> a +foldr1 _ [x] = x +foldr1 f (x:xs) = f x (foldr1 f xs) +foldr1 _ [] = error "Prelude.foldr1: empty list" + +scanr :: (a -> b -> b) -> b -> [a] -> [b] +scanr _ q0 [] = [q0] +scanr f q0 (x:xs) = + case scanr f q0 xs of + qs@(q:_) -> f x q : qs + _ -> error "Prelude.scanr" + +scanr1 :: (a -> a -> a) -> [a] -> [a] +scanr1 _ [] = [] +scanr1 _ [x] = [x] +scanr1 f (x:xs) = + case scanr1 f xs of + qs@(q:_) -> f x q : qs + _ -> error "Prelude.scanr" + +iterate :: (a -> a) -> a -> [a] +iterate f x = x : iterate f (f x) + +repeat :: a -> [a] +repeat x = xs where xs = x:xs + +replicate :: Int -> a -> [a] +replicate n x = take n (repeat x) + +cycle :: [a] -> [a] +cycle [] = error "Prelude.cycle: empty list" +cycle xs = xs' where xs'=xs++xs' + +take :: Int -> [a] -> [a] +take n xs + | n <= 0 = [] + | otherwise = + case xs of + [] -> [] + (y:ys) -> y : take (n-1) ys + +drop :: Int -> [a] -> [a] +drop n xs + | n <= 0 = xs + | otherwise = + case xs of + [] -> [] + (_:ys) -> drop (n-1) ys + +splitAt :: Int -> [a] -> ([a], [a]) +splitAt n xs + | n <= 0 = ([],xs) + | otherwise = + case xs of + [] -> ([],[]) + (y:ys) -> (y:as,bs) where (as,bs) = splitAt (n-1) ys + +takeWhile :: (a -> Bool) -> [a] -> [a] +takeWhile _ [] = [] +takeWhile p (x:xs) + | p x = x : takeWhile p xs + | otherwise = [] + +dropWhile :: (a -> Bool) -> [a] -> [a] +dropWhile _ [] = [] +dropWhile p l@(x:xs) + | p x = dropWhile p xs + | otherwise = l + +span :: (a -> Bool) -> [a] -> ([a],[a]) +span _ [] = ([],[]) +span p xs@(x:xs') + | p x = (x:ys, zs) + | otherwise = ([],xs) + where (ys,zs) = span p xs' + +break :: (a -> Bool) -> [a] -> ([a],[a]) +break p = span (not . p) + +lines :: String -> [String] +lines "" = [] +lines s = let l,s' :: String + (l,s') = break (\x -> x == '\n') s + in l : case s' of [] -> [] + (_:s'') -> lines s'' + +words :: String -> [String] +words s = + case dropWhile localIsSpace s of + "" -> [] + s' -> w : words s'' + where w,s'' :: String + (w,s'') = break localIsSpace s' + +unlines :: [String] -> String +unlines [] = [] +unlines (l:ls) = l ++ '\n' : unlines ls + +unwords :: [String] -> String +unwords [] = "" +unwords [w] = w +unwords (w:ws) = w ++ ' ' : unwords ws + +reverse :: [a] -> [a] +reverse = foldl (flip (:)) [] + +and :: [Bool] -> Bool +and = foldr (&&) True + +or :: [Bool] -> Bool +or = foldr (||) False + +any :: (a -> Bool) -> [a] -> Bool +any p = or . map p + +all :: (a -> Bool) -> [a] -> Bool +all p = and . map p + +concatMap :: (a -> [b]) -> [a] -> [b] +concatMap f = concat . map f + +{----------------------------------------------- + -- Conversion + -----------------------------------------------} + +-- see also "read.." and "show.." below + +{- imported from PreludePrim + +primOrd :: Char -> Int +primChr :: Int -> Char + +intToFloat :: Int -> Float +round :: Float -> Int +floor :: Float -> Int +ceiling :: Float -> Int +truncate :: Float -> Int +-} + +{----------------------------------------------- + -- Some standard functions + -----------------------------------------------} + +fix :: (a -> a) -> a +fix f = x where x = f x + +id :: a -> a +id x = x + +const :: a -> b -> a +const x _ = x + +(.) :: (b -> c) -> (a -> b) -> (a -> c) +(.) f g x = f (g x) + +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x + +($) :: (a -> b) -> a -> b +f $ x = f x + +{- imported from PreludePrim + +seq :: a -> b -> b +($!) :: (a -> b) -> a -> b +error :: String -> a + +-} + +until :: (a -> Bool) -> (a -> a) -> a -> a +until p f x = if p x then x else until p f (f x) + +undefined :: a +undefined = error "undefined" + +{----------------------------------------------- + -- IO + -----------------------------------------------} + +(>>=) :: IO a -> (a -> IO b) -> IO b +(>>=) io f = do x <- io + f x + +(>>) :: IO a -> IO b -> IO b +p >> q = p >>= \ _ -> q + +{- imported from PreludePrim +return :: a -> IO a + +putChar :: Char -> IO () +putChar c = primPutChar c + +putStr :: String -> IO () +putStr s = primPutStr s + +putStrLn :: String -> IO () +putStrLn s = primPutStrLn s + +unsafePerformIO :: IO a -> a +unsafePerformIO = primUnsafePerformIO +-} + +sequence_ :: [IO a] -> IO () +sequence_ = foldr (>>) (return ()) + +print :: Show a => a -> IO () +print e = putStrLn (show e) + +getLine :: IO String +getLine = do + c <- getChar + if c == '\n' + then return "" + else do cs <- getLine + return (c:cs) + +writeFile :: String -> String -> IO () +writeFile fname s + = bracketIO (openFile fname WriteMode) + (hClose) + (\h -> hPutString h s) + +readFile :: String -> IO String +readFile fname + = bracketIO (openFile fname ReadMode) + (hClose) + (\h -> readAll h []) + where + readAll h acc + = do c <- hGetChar h + readAll h (c:acc) + `catchEof` (return (reverse acc)) + +bracketIO :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c +bracketIO acquire release action + = do x <- acquire + finallyIO (action x) (release x) + +finallyIO :: IO a -> IO b -> IO a +finallyIO io action + = do x <- io `catch` (\exn -> do{ action; raise exn }) + action + return x + +{----------------------------------------------- + -- Read + -----------------------------------------------} + +readInt :: String -> Int +readInt [] = 0 +readInt ('-':s) = - readUnsigned s +readInt s = readUnsigned s + +readUnsigned :: String -> Int +readUnsigned = + foldl (\a b -> a * 10 + b) 0 + . + map (\c -> primOrd c - primOrd '0') + . + takeWhile localIsDigit diff --git a/lib/Prelude.type b/lib/Prelude.type new file mode 100644 --- /dev/null +++ b/lib/Prelude.type @@ -0,0 +1,57 @@ +-------------------------------------------------------- +-- Type inference directives: Sibling functions + +-- int versus float arithmetic +siblings + , +. ; +siblings * , *. ; +siblings - , -. ; +siblings ^ , ^. ; +siblings div , /. ; +siblings / , /. ; + +-- int versus float comparison functions +siblings >== , >=. ; +siblings <= , <=. ; +siblings == , ==. ; +siblings /= , /=. ; +siblings < , <. ; +siblings > , >. ; + +-- binary and n-ary operations +siblings max , maximum ; +siblings min , minimum ; +siblings sum , + ; +siblings product , * ; + +-- maybe constructors +siblings Just , Nothing ; + +-- either constructors +siblings Left , Right ; + +-- tuple functions +siblings fst , snd ; +siblings curry , uncurry ; +siblings zip , zip3 , unzip , unzip3 ; + +-- list functions +siblings : , ++ ; +siblings foldl , foldl1 , scanl , scanl1 ; +siblings foldr , foldr1 , scanr , scanr1 ; +siblings words , unwords ; +siblings lines , unlines ; +siblings map , concatMap ; + +-- Helium specific functions +siblings == , eqChar, eqMaybe, eqBool, eqList, eqTuple2, eqString ; +siblings ordString, ordChar, ordInt, ordList ; +siblings showBool , showChar , showFloat , showInt ; +siblings showString , showList , showMaybe , showEither , showOrdering , + howUnit , showTuple2 , showTuple3 , showTuple4 , showTuple5 , + showTuple6 , showTuple7 , showTuple8, showTuple9, showTuple10 ; + +-- Java string concat +siblings + , ++ ; + +-- Char, Int conversions +siblings ord , chr ; diff --git a/lib/PreludePrim.core b/lib/PreludePrim.core new file mode 100644 --- /dev/null +++ b/lib/PreludePrim.core @@ -0,0 +1,910 @@ +module PreludePrim + ( + -- Conversion + primOrd, primChr, intToFloat, ceiling, floor, truncate, round + + -- Num + , (+), (-), (*), negate, fromInt + + -- Eq + , (==), (/=) + + -- Ord + , (<), (>), (<=), (>=), compare + + -- Show + , show + + -- Enum + , toEnum, fromEnum, succ, pred + , enumFrom, enumFromThen, enumFromTo, enumFromThenTo + + -- Int + , div, mod, quot, rem + + -- Float + , (/) + , sqrt, (**.), exp, log, sin, cos, tan + + -- IO monad + , return + , unsafePerformIO + , putChar, putStr, putStrLn + + -- IO files + , getChar + , Handle, stdin, stdout, stderr + , IOMode(..), openFile, hClose + , hGetChar, hPutChar, hPutString + + -- strictness + , ($!), seq + + -- misc + , error, catch, catchEof, raise + + -- dictionaries + , ''$dictShowInt'', ''$dictShowFloat'', ''$dictShowChar'', ''$dictShowBool'', ''$dictShow[]'' + , ''$dictShow()'', ''$dictShow(,)'', ''$dictShow(,,)'', ''$dictShow(,,,)'', ''$dictShow(,,,,)'', ''$dictShow(,,,,,)'' + , ''$dictShow(,,,,,,)'', ''$dictShow(,,,,,,,)'', ''$dictShow(,,,,,,,,)'', ''$dictShow(,,,,,,,,,)'' + + , ''$dictEqInt'', ''$dictEqFloat'', ''$dictEqChar'', ''$dictEqBool'', ''$dictEq[]'' + , ''$dictEq()'', ''$dictEq(,)'', ''$dictEq(,,)'', ''$dictEq(,,,)'', ''$dictEq(,,,,)'', ''$dictEq(,,,,,)'' + , ''$dictEq(,,,,,,)'', ''$dictEq(,,,,,,,)'', ''$dictEq(,,,,,,,,)'', ''$dictEq(,,,,,,,,,)'' + + , ''$dictNumInt'', ''$dictNumFloat'' + + , ''$dictOrdInt'', ''$dictOrdFloat'', ''$dictOrdChar'', ''$dictOrdBool'', ''$dictOrd[]'' + , ''$dictOrd()'', ''$dictOrd(,)'', ''$dictOrd(,,)'', ''$dictOrd(,,,)'', ''$dictOrd(,,,,)'', ''$dictOrd(,,,,,)'' + , ''$dictOrd(,,,,,,)'', ''$dictOrd(,,,,,,,)'', ''$dictOrd(,,,,,,,,)'', ''$dictOrd(,,,,,,,,,)'' + , ''$dictShowOrdering'' + + , Ordering(EQ, LT, GT), showOrdering + + , ''$getEqFromOrd'', ''$getEqFromNum'', ''$getShowFromNum'' + + , ''$dictEnumInt'', ''$dictEnumFloat'', ''$dictEnum()'', ''$dictEnumChar'', ''$dictEnumBool'' + ) where + +import HeliumLang + ( showFloat, showInt, showBool, showChar, showList, showUnit, showString + , showTuple2, showTuple3, showTuple4, showTuple5, showTuple6, showTuple7 + , showTuple8, showTuple9, showTuple10 + , ''$negate'', ''$show'' + , ''$enumFrom'', ''$enumFromThen'', ''$enumFromTo'', ''$enumFromThenTo'' + , ''$primPutChar'', ''$primPutStr'', ''$primPutStrLn'', ''$primUnsafePerformIO'' + ) + +import LvmLang + ( (+#) = (+), (*#) = (*), (-#) = (-), negInt + , (==#) = (==), (/=#) = (/=) + , (<#) = (<), (<=#) = (<=), (>=#) = (>=), (>#) = (>) + , mod = (%), quot, rem, div = (/) + + , (+.), (*.), (-.), (/) = (/.), negFloat + , (==.), (/=.) + , (<.), (<=.), (>=.), (>.) + + , primPackedToString = stringFromPacked + + , Int(), Float(), IO() + , custom "typedecl" String + , Bool(True, False) + , '':[]''('':[]'', (:)) + , '':()''('':()'') + , bindIO, return = returnIO + , primPackedToString = stringFromPacked + , primUnsafePerformIO = unsafePerformIO + + , ($!), seq + , True -- hack + ) + +import LvmIO + ( stdinChannel = stdin, stdoutChannel = stdout, stderrChannel = stderr + , Channel(), Input(), Output() + , CreateMode(CreateIfNotExists, CreateOverwrite) + , openInputFile, openOutputFile + , close, flush + , inputChar, outputChar, outputString + ) + +import LvmException + ( error, errorPacked {- hack -}, catch, raise + , Exception(System), SystemException(EndOfFile) + ) + +custom infix (+) : public [6,"left"] +custom infix (-) : public [6,"left"] +custom infix (*) : public [7,"left"] +custom infix div : public [7,"left"] +custom infix mod : public [7,"left"] +custom infix quot : public [7,"left"] +custom infix rem : public [7,"left"] + +custom infix (==) : public [4,"none"] +custom infix (/=) : public [4,"none"] +custom infix (<) : public [4,"none"] +custom infix (>) : public [4,"none"] +custom infix (<=) : public [4,"none"] +custom infix (>=) : public [4,"none"] + +custom infix (/) : public [7,"left"] + +custom infix (**.) : public [8,"right"] +custom infix ($!) : public [0,"right"] + +primOrd :: Char -> Int +primOrd x = x + +primChr :: Int -> Char +primChr x = x + +{-------------------------------------------------------------------------- + IO +--------------------------------------------------------------------------} +putChar :: Char -> IO () +putChar c = ''$primPutChar''c + +putStr :: String -> IO () +putStr s = ''$primPutStr'' s + +putStrLn :: String -> IO () +putStrLn s = ''$primPutStrLn'' s + +unsafePerformIO :: IO a -> a +unsafePerformIO io + = ''$primUnsafePerformIO'' io + + +-- Float + +extern primFloatSqrt "fp_sqrt" :: "FF" +extern float_of_string_extern "float_of_string" :: "Fz" + +sqrt :: Float -> Float +sqrt x = let! x = x + y = float_of_string_extern "0.0" + in + case (>=) ''$dictOrdFloat'' x y of + { True -> primFloatSqrt x + ; _ -> errorPacked "Can't apply sqrt to negative floating-point number" + } + +extern primFloatPower "fp_pow" :: "FFF" + +(**.) :: Float -> Float -> Float +(**.) x y = let! x = x in let! y = y in primFloatPower x y + +extern primFloatExp "fp_exp" :: "FF" + +exp :: Float -> Float +exp x = let! x = x in primFloatExp x + +extern primFloatLog "fp_log" :: "FF" + +log :: Float -> Float +log x = let! x = x in primFloatLog x + +extern primFloatSin "fp_sin" :: "FF" + +sin :: Float -> Float +sin x = let! x = x in primFloatSin x + +extern primFloatCos "fp_cos" :: "FF" + +cos :: Float -> Float +cos x = let! x = x in primFloatCos x + +extern primFloatTan "fp_tan" :: "FF" + +tan :: Float -> Float +tan x = let! x = x in primFloatTan x + +extern primIntToFloat "float_of_int" :: "FI" + +intToFloat :: Int -> Float +intToFloat x = let! x = x in primIntToFloat x + +extern primFloatCeil "fp_ceil" :: "FF" + +ceiling :: Float -> Int +ceiling x = let! x = x + y = primFloatCeil x + in primFloatTruncateInt y + +extern primFloatFloor "fp_floor" :: "FF" + +floor :: Float -> Int +floor x = let! x = x + y = primFloatFloor x + in primFloatTruncateInt y + +extern primFloatTruncateInt "fp_trunc_int" :: "IF" + +truncate :: Float -> Int +truncate x = let! x = x in primFloatTruncateInt x + +extern primFloatNear "fp_near" :: "FF" +extern primFloatRoundInt "fp_round_int" :: "IF" + +round :: Float -> Int +round x + = let! y = x + z = primFloatNear y + i = primFloatRoundInt z + in i + +-- Overloading + +{- Show -} + +''$dictShowInt'' :: "DictShowInt" +''$dictShowInt'' = (@0, 2) showInt (showList showInt) + +''$dictShowFloat'' :: "DictShowFloat" +''$dictShowFloat'' = (@0, 2) showFloat (showList showFloat) + +''$dictShowBool'' :: "DictShowBool" +''$dictShowBool'' = (@0, 2) showBool (showList showBool) + +''$dictShowChar'' :: "DictShowChar" +''$dictShowChar'' = (@0, 2) showChar showString + +''$dictShowOrdering'' :: "DictShowOrdering" +''$dictShowOrdering'' = (@0, 2) showOrdering (showList showOrdering) + +''$dictShow[]'' :: "DictShowList" +''$dictShow[]'' dict = (@0, 2) (showAList dict) (showList (showAList dict)) + +''$dictShow()'' :: "DictShowTuple0" +''$dictShow()'' = (@0, 2) showUnit (showList showUnit) + +''$dictShow(,)'' :: "DictShowTuple2" +''$dictShow(,)'' d1 d2 = + let! x = showTuple2 (show d1) (show d2) + in (@0, 2) x (showList x) + +''$dictShow(,,)'' :: "DictShowTuple3" +''$dictShow(,,)'' d1 d2 d3 = + let! x = showTuple3 (show d1) (show d2) (show d3) + in (@0, 2) x (showList x) + +''$dictShow(,,,)'' :: "DictShowTuple4" +''$dictShow(,,,)'' d1 d2 d3 d4 = + let! x = showTuple4 (show d1) (show d2) (show d3) (show d4) + in (@0, 2) x (showList x) + +''$dictShow(,,,,)'' :: "DictShowTuple5" +''$dictShow(,,,,)'' d1 d2 d3 d4 d5 = + let! x = showTuple5 (show d1) (show d2) (show d3) (show d4) (show d5) + in (@0, 2) x (showList x) + +''$dictShow(,,,,,)'' :: "DictShowTuple6" +''$dictShow(,,,,,)'' d1 d2 d3 d4 d5 d6 = + let! x = showTuple6 (show d1) (show d2) (show d3) (show d4) (show d5) + (show d6) + in (@0, 2) x (showList x) + +''$dictShow(,,,,,,)'' :: "DictShowTuple7" +''$dictShow(,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 = + let! x = showTuple7 (show d1) (show d2) (show d3) (show d4) (show d5) + (show d6) (show d7) + in (@0, 2) x (showList x) + +''$dictShow(,,,,,,,)'' :: "DictShowTuple8" +''$dictShow(,,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 d8 = + let! x = showTuple8 (show d1) (show d2) (show d3) (show d4) (show d5) + (show d6) (show d7) (show d8) + in (@0, 2) x (showList x) + +''$dictShow(,,,,,,,,)'' :: "DictShowTuple9" +''$dictShow(,,,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 d8 d9 = + let! x = showTuple9 (show d1) (show d2) (show d3) (show d4) (show d5) + (show d6) (show d7) (show d8) (show d9) + in (@0, 2) x (showList x) + +''$dictShow(,,,,,,,,,)'' :: "DictShowTuple10" +''$dictShow(,,,,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 = + let! x = showTuple10 (show d1) (show d2) (show d3) (show d4) (show d5) + (show d6) (show d7) (show d8) (show d9) (show d10) + in (@0, 2) x (showList x) + +show :: "Show a => a -> String" +show dShow = + case dShow of + (@0, 2) x1 x2 -> x1 + +-- not exported +showAList :: "Show a => [a] -> String" +showAList dShow = + case dShow of + (@0, 2) x1 x2 -> x2 + +{- Num -} + +''$dictNumInt'' :: "DictNumInt" +''$dictNumInt'' = (@0, 7) ''$dictEqInt'' ''$dictShowInt'' (+#) (*#) (-#) negInt id + +''$dictNumFloat'' :: "DictNumFloat" +''$dictNumFloat'' = (@0, 7) ''$dictEqFloat'' ''$dictShowFloat'' (+.) (*.) (-.) negFloat intToFloat {- fromInt -} + +id x = x + +''$getEqFromNum'' :: "GetEqFromNum" +''$getEqFromNum'' dNum = + case dNum of + (@0, 7) x1 x2 x3 x4 x5 x6 x7 -> x1 + +''$getShowFromNum'' :: "GetShowFromNum" +''$getShowFromNum'' dNum = + case dNum of + (@0, 7) x1 x2 x3 x4 x5 x6 x7 -> x2 + +(+) :: "Num a => a -> a -> a" +(+) dNum = + case dNum of + (@0, 7) x1 x2 x3 x4 x5 x6 x7 -> x3 + +(*) :: "Num a => a -> a -> a" +(*) dNum = + case dNum of + (@0, 7) x1 x2 x3 x4 x5 x6 x7 -> x4 + +(-) :: "Num a => a -> a -> a" +(-) dNum = + case dNum of + (@0, 7) x1 x2 x3 x4 x5 x6 x7 -> x5 + + +negate :: "Num a => a -> a" +negate dNum = ''$negate'' dNum + +fromInt :: "Num a => Int -> a" +fromInt dNum = + case dNum of + (@0, 7) x1 x2 x3 x4 x5 x6 x7 -> x7 + + + +{- Eq -} + +''$dictEqInt'' :: "DictEqInt" +''$dictEqInt'' = (==#) + +''$dictEqFloat'' :: "DictEqFloat" +''$dictEqFloat'' = (==.) + +''$dictEqBool'' :: "DictEqBool" +''$dictEqBool'' = eqBool + +''$dictEq[]'' :: "DictEqList" +''$dictEq[]'' dict = eqList dict + +''$dictEqChar'' :: "DictEqChar" +''$dictEqChar'' = ''$dictEqInt'' + +''$dictEq()'' :: "DictEqTuple0" +''$dictEq()'' = \x y -> + case x of { '':()'' -> case y of { '':()'' -> True } } + +''$dictEq(,)'' :: "DictEqTuple2" +''$dictEq(,)'' d1 d2 = \x y -> + case x of { (@0, 2) x1 x2 -> case y of { (@0, 2) y1 y2 -> + allTrue [ (==) d1 x1 y1, (==) d2 x2 y2 ] } } + +''$dictEq(,,)'' :: "DictEqTuple3" +''$dictEq(,,)'' d1 d2 d3 = \x y -> + case x of { (@0, 3) x1 x2 x3 -> + case y of { (@0, 3) y1 y2 y3 -> + allTrue [ (==) d1 x1 y1, (==) d2 x2 y2, (==) d3 x3 y3 ] } } + +''$dictEq(,,,)'' :: "DictEqTuple4" +''$dictEq(,,,)'' d1 d2 d3 d4 = \x y -> + case x of { (@0, 4) x1 x2 x3 x4 -> + case y of { (@0, 4) y1 y2 y3 y4 -> + allTrue [ (==) d1 x1 y1, (==) d2 x2 y2, (==) d3 x3 y3, (==) d4 x4 y4 ] } } + +''$dictEq(,,,,)'' :: "DictEqTuple5" +''$dictEq(,,,,)'' d1 d2 d3 d4 d5 = \x y -> + case x of { (@0, 5) x1 x2 x3 x4 x5 -> + case y of { (@0, 5) y1 y2 y3 y4 y5 -> + allTrue [ (==) d1 x1 y1, (==) d2 x2 y2, (==) d3 x3 y3, (==) d4 x4 y4 + , (==) d5 x5 y5 ] } } + +''$dictEq(,,,,,)'' :: "DictEqTuple6" +''$dictEq(,,,,,)'' d1 d2 d3 d4 d5 d6 = \x y -> + case x of { (@0, 6) x1 x2 x3 x4 x5 x6 -> + case y of { (@0, 6) y1 y2 y3 y4 y5 y6 -> + allTrue [ (==) d1 x1 y1, (==) d2 x2 y2, (==) d3 x3 y3, (==) d4 x4 y4 + , (==) d5 x5 y5, (==) d6 x6 y6 ] } } + +''$dictEq(,,,,,,)'' :: "DictEqTuple7" +''$dictEq(,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 = \x y -> + case x of { (@0, 7) x1 x2 x3 x4 x5 x6 x7 -> + case y of { (@0, 7) y1 y2 y3 y4 y5 y6 y7 -> + allTrue [ (==) d1 x1 y1, (==) d2 x2 y2, (==) d3 x3 y3, (==) d4 x4 y4 + , (==) d5 x5 y5, (==) d6 x6 y6, (==) d7 x7 y7 ] } } + +''$dictEq(,,,,,,,)'' :: "DictEqTuple8" +''$dictEq(,,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 d8 = \x y -> + case x of { (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> + case y of { (@0, 8) y1 y2 y3 y4 y5 y6 y7 y8 -> + allTrue [ (==) d1 x1 y1, (==) d2 x2 y2, (==) d3 x3 y3, (==) d4 x4 y4 + , (==) d5 x5 y5, (==) d6 x6 y6, (==) d7 x7 y7, (==) d8 x8 y8 + ] } } + +''$dictEq(,,,,,,,,)'' :: "DictEqTuple9" +''$dictEq(,,,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 d8 d9 = \x y -> + case x of { (@0, 9) x1 x2 x3 x4 x5 x6 x7 x8 x9 -> + case y of { (@0, 9) y1 y2 y3 y4 y5 y6 y7 y8 y9 -> + allTrue [ (==) d1 x1 y1, (==) d2 x2 y2, (==) d3 x3 y3, (==) d4 x4 y4 + , (==) d5 x5 y5, (==) d6 x6 y6, (==) d7 x7 y7, (==) d8 x8 y8 + , (==) d9 x9 y9 ] } } + +''$dictEq(,,,,,,,,,)'' :: "DictEqTuple10" +''$dictEq(,,,,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 = \x y -> + case x of { (@0, 10) x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 -> + case y of { (@0, 10) y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 -> + allTrue [ (==) d1 x1 y1, (==) d2 x2 y2, (==) d3 x3 y3, (==) d4 x4 y4 + , (==) d5 x5 y5, (==) d6 x6 y6, (==) d7 x7 y7, (==) d8 x8 y8 + , (==) d9 x9 y9, (==) d10 x10 y10 ] } } + +allTrue xs = + case xs of + [] -> True + (:) b bs -> case b of False -> False + _ -> allTrue bs + + +(==) :: "Eq a => a -> a -> Bool" +(==) dEq = dEq + +(/=) :: "Eq a => a -> a -> Bool" +(/=) dEq = \x y -> not (dEq x y) + +eqBool x y = + case x of + True -> y + False -> not y + +eqList ''$dictEqElem'' xs ys = + case xs of + (:) xh xt -> + case ys of + (:) yh yt -> + case (==) ''$dictEqElem'' xh yh of + True -> eqList ''$dictEqElem'' xt yt + False -> False + _ -> False + _ -> case ys of + [] -> True + _ -> False + +not :: Bool -> Bool +not x = case x of True -> False + False -> True + +{- Ord -} + +''$dictOrdInt'' :: "DictOrdInt" +''$dictOrdInt'' = (@0, 2) ''$dictEqInt'' compareInt + + +''$dictOrdFloat'' :: "DictOrdFloat" +''$dictOrdFloat'' = (@0, 2) ''$dictEqFloat'' compareFloat + +''$dictOrdChar'' :: "DictOrdChar" +''$dictOrdChar'' = ''$dictOrdInt'' + +''$dictOrdBool'' :: "DictOrdBool" +''$dictOrdBool'' = (@0, 2) ''$dictEqBool'' compareBool + +''$dictOrd[]'' :: "DictOrdList" +''$dictOrd[]'' dict = (@0, 2) ''$dictEq[]'' (compareList dict) + +''$dictOrd()'' :: "DictOrdTuple0" +''$dictOrd()'' = + (@0, 2) ''$dictEq()'' + (\x y -> + case x of { '':()'' -> + case y of { '':()'' -> + EQ } } ) + +''$dictOrd(,)'' :: "DictOrdTuple2" +''$dictOrd(,)'' d1 d2 = + (@0, 2) ''$dictEq(,)'' + (\x y -> + case x of { (@0, 2) x1 x2 -> + case y of { (@0, 2) y1 y2 -> + lexico [ compare d1 x1 y1, compare d2 x2 y2 ] } } ) + +''$dictOrd(,,)'' :: "DictOrdTuple3" +''$dictOrd(,,)'' d1 d2 d3 = + (@0, 2) ''$dictEq(,,)'' + (\x y -> + case x of { (@0, 3) x1 x2 x3 -> + case y of { (@0, 3) y1 y2 y3 -> + lexico [ compare d1 x1 y1, compare d2 x2 y2, compare d3 x3 y3 ] } } ) + +''$dictOrd(,,,)'' :: "DictOrdTuple4" +''$dictOrd(,,,)'' d1 d2 d3 d4 = + (@0, 2) ''$dictEq(,,,)'' + (\x y -> + case x of { (@0, 4) x1 x2 x3 x4 -> + case y of { (@0, 4) y1 y2 y3 y4 -> + lexico [ compare d1 x1 y1, compare d2 x2 y2, compare d3 x3 y3, compare d4 x4 y4 + ] } } ) + +''$dictOrd(,,,,)'' :: "DictOrdTuple5" +''$dictOrd(,,,,)'' d1 d2 d3 d4 d5 = + (@0, 2) ''$dictEq(,,,,)'' + (\x y -> + case x of { (@0, 5) x1 x2 x3 x4 x5 -> + case y of { (@0, 5) y1 y2 y3 y4 y5 -> + lexico [ compare d1 x1 y1, compare d2 x2 y2, compare d3 x3 y3, compare d4 x4 y4 + , compare d5 x5 y5 ] } } ) + +''$dictOrd(,,,,,)'' :: "DictOrdTuple6" +''$dictOrd(,,,,,)'' d1 d2 d3 d4 d5 d6 = + (@0, 2) ''$dictEq(,,,,,)'' + (\x y -> + case x of { (@0, 6) x1 x2 x3 x4 x5 x6 -> + case y of { (@0, 6) y1 y2 y3 y4 y5 y6 -> + lexico [ compare d1 x1 y1, compare d2 x2 y2, compare d3 x3 y3, compare d4 x4 y4 + , compare d5 x5 y5, compare d6 x6 y6 ] } } ) + +''$dictOrd(,,,,,,)'' :: "DictOrdTuple7" +''$dictOrd(,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 = + (@0, 2) ''$dictEq(,,,,,,)'' + (\x y -> + case x of { (@0, 7) x1 x2 x3 x4 x5 x6 x7 -> + case y of { (@0, 7) y1 y2 y3 y4 y5 y6 y7 -> + lexico [ compare d1 x1 y1, compare d2 x2 y2, compare d3 x3 y3, compare d4 x4 y4 + , compare d5 x5 y5, compare d6 x6 y6, compare d7 x7 y7 ] } } ) + +''$dictOrd(,,,,,,,)'' :: "DictOrdTuple8" +''$dictOrd(,,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 d8 = + (@0, 2) ''$dictEq(,,,,,,,)'' + (\x y -> + case x of { (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> + case y of { (@0, 8) y1 y2 y3 y4 y5 y6 y7 y8 -> + lexico [ compare d1 x1 y1, compare d2 x2 y2, compare d3 x3 y3, compare d4 x4 y4 + , compare d5 x5 y5, compare d6 x6 y6, compare d7 x7 y7, compare d8 x8 y8 + ] } } ) + +''$dictOrd(,,,,,,,,)'' :: "DictOrdTuple9" +''$dictOrd(,,,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 d8 d9 = + (@0, 2) ''$dictEq(,,,,,,,,)'' + (\x y -> + case x of { (@0, 9) x1 x2 x3 x4 x5 x6 x7 x8 x9 -> + case y of { (@0, 9) y1 y2 y3 y4 y5 y6 y7 y8 y9 -> + lexico [ compare d1 x1 y1, compare d2 x2 y2, compare d3 x3 y3, compare d4 x4 y4 + , compare d5 x5 y5, compare d6 x6 y6, compare d7 x7 y7, compare d8 x8 y8 + , compare d9 x9 y9 ] } } ) + +''$dictOrd(,,,,,,,,,)'' :: "DictOrdTuple10" +''$dictOrd(,,,,,,,,,)'' d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 = + (@0, 2) ''$dictEq(,,,,,,,,,)'' + (\x y -> + case x of { (@0, 10) x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 -> + case y of { (@0, 10) y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 -> + lexico [ compare d1 x1 y1, compare d2 x2 y2, compare d3 x3 y3, compare d4 x4 y4 + , compare d5 x5 y5, compare d6 x6 y6, compare d7 x7 y7, compare d8 x8 y8 + , compare d9 x9 y9, compare d10 x10 y10 ] } } ) + +lexico xs = + case xs of + [] -> EQ + (:) o os -> + case o of + EQ -> lexico os + _ -> o + +''$getEqFromOrd'' :: "GetEqFromOrd" +''$getEqFromOrd'' dOrd = + case dOrd of + (@0, 2) eq cmp -> eq + +(<) :: "Ord a => a -> a -> Bool" +(<) dOrd x y = + case dOrd of + (@0, 2) eq cmp -> + case cmp x y of + LT -> True + _ -> False + +(<=) :: "Ord a => a -> a -> Bool" +(<=) dOrd x y = + case dOrd of + (@0, 2) eq cmp -> + case cmp x y of + GT -> False + _ -> True + +(>=) :: "Ord a => a -> a -> Bool" +(>=) dOrd x y = + case dOrd of + (@0, 2) eq cmp -> + case cmp x y of + LT -> False + _ -> True + +(>) :: "Ord a => a -> a -> Bool" +(>) dOrd x y = + case dOrd of + (@0, 2) eq cmp -> + case cmp x y of + GT -> True + _ -> False + +compare :: "Ord a => a -> a -> Ordering" +compare dOrd = + case dOrd of + (@0, 2) eq cmp -> cmp + + +compareInt x y = + case (<#) x y of + True -> LT + _ -> case (==#) x y of + True -> EQ + _ -> GT + +compareFloat x y = + case (<.) x y of + True -> LT + _ -> case (==.) x y of + True -> EQ + _ -> GT + +compareBool x y = + case x of + True -> case y of True -> EQ + _ -> GT + _ -> case y of True -> LT + _ -> EQ + +{- Enum -} + +const x y = x +map f xs = case xs of + [] -> [] ; + (:) x xs -> (:) (f x) (map f xs) + +''$dictEnumInt'' :: "DictEnumInt" +''$dictEnumInt'' = (@0, 8) id id enumFromInt enumFromThenInt enumSuccInt enumPredInt enumFromToInt enumFromThenToInt + +enumSuccInt x = (+#) x 1 +enumPredInt x = (-#) x 1 +enumFromInt = enumIntWithSteps (const True) 1 +enumFromThenInt x y = enumIntWithSteps (const True) ((-#) y x) x +enumFromToInt x y = enumIntWithSteps ((>=#) y) 1 x +enumFromThenToInt x y z = + case compareInt x y of + LT -> enumIntWithSteps ((>=#) z) ((-#) y x) x; + EQ -> enumIntWithSteps (const True) 0 x ; + GT -> enumIntWithSteps ((<=#) z) ((-#) y x) x + +enumIntWithSteps p d x = + case p x of + True -> (:) x (enumIntWithSteps p d ((+#) d x)) ; + _ -> [] + +''$dictEnumFloat'' :: "DictEnumFloat" +''$dictEnumFloat'' = (@0, 8) toEnumFloat truncate enumFromFloat enumFromThenFloat enumSuccFloat enumPredFloat enumFromToFloat enumFromThenToFloat + +toEnumFloat x = let! x = x in primIntToFloat x +enumSuccFloat x = let! x = ((+#) (truncate x) 1) in primIntToFloat x +enumPredFloat x = let! x = ((-#) (truncate x) 1) in primIntToFloat x +enumFromFloat = let! one = primIntToFloat 1 in enumFloatWithSteps (const True) one +enumFromThenFloat x y = enumFloatWithSteps (const True) ((-.) y x) x +enumFromToFloat x y = let! one = primIntToFloat 1 in enumFloatWithSteps ((>=.) y) one x +enumFromThenToFloat x y z = + case compareFloat x y of + LT -> enumFloatWithSteps ((>=.) z) ((-.) y x) x; + EQ -> let! zero = primIntToFloat 0 in enumFloatWithSteps (const True) zero x ; + GT -> enumFloatWithSteps ((<=.) z) ((-.) y x) x + +enumFloatWithSteps p d x = + case p x of + True -> (:) x (enumFloatWithSteps p d ((+.) d x)) ; + _ -> [] + +''$dictEnum()'' :: "DictEnumTuple0" +''$dictEnum()'' = makeEnumDict toEnumVoid fromEnumVoid enumFromVoid enumFromThenVoid + +toEnumVoid i = + case i of + 0 -> () ; + _ -> errorPacked "illegal () enumeration" +fromEnumVoid _ = 0 +enumFromVoid _ = [()] +enumFromThenVoid _ _ = [()] + +''$dictEnumChar'' :: "DictEnumChar" +''$dictEnumChar'' = makeEnumDict primChr primOrd enumFromChar enumFromThenChar + +enumFromChar x = enumCharWithSteps 1 (primOrd x) +enumFromThenChar x y = enumCharWithSteps ((-#) (primOrd y) (primOrd x)) (primOrd x) +enumCharWithSteps d x = + case (<#) x 0 of + True -> [] ; + _ -> case (>#) x 255 of + True -> [] ; + _ -> (:) (primChr x) (enumCharWithSteps d ((+#) d x)) + +''$dictEnumBool'' :: "DictEnumBool" +''$dictEnumBool'' = makeEnumDict toEnumBool fromEnumBool enumFromBool enumFromThenBool + +toEnumBool i = + case i of + 0 -> False ; + 1 -> True ; + _ -> errorPacked "illegal boolean enumeration" +fromEnumBool b = + case b of { + False -> 0 ; + True -> 1 } + +enumFromBool b = map toEnumBool (enumFromToInt (fromEnumBool b) 1) +enumFromThenBool b1 b2 = + case b1 of { + False -> map toEnumBool (enumFromThenToInt (fromEnumBool b1) (fromEnumBool b2) 1) ; + _ -> map toEnumBool (enumFromThenToInt (fromEnumBool b1) (fromEnumBool b2) 0) } + +toEnum :: "Enum a => Int -> a" +toEnum dEnum = + case dEnum of + (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> x1 + +fromEnum :: "Enum a => a -> Int" +fromEnum dEnum = + case dEnum of + (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> x2 + +succ :: "Enum a => a -> a" +succ dEnum = + case dEnum of + (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> x5 + +pred :: "Enum a => a -> a" +pred dEnum = + case dEnum of + (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> x6 + +enumFrom :: "Enum a => a -> [a]" +enumFrom dEnum = + ''$enumFrom'' dEnum + +enumFromThen :: "Enum a => a -> a -> [a]" +enumFromThen dEnum = + ''$enumFromThen'' dEnum + +enumFromTo :: "Enum a => a -> a -> [a]" +enumFromTo dEnum = + ''$enumFromTo'' dEnum + +enumFromThenTo :: "Enum a => a -> a -> a -> [a]" +enumFromThenTo dEnum = + ''$enumFromThenTo'' dEnum + +makeEnumDict f1 f2 f3 f4 = + (@0, 8) f1 f2 f3 f4 (enumSuccDefault f1 f2) (enumPredDefault f1 f2) (enumFromToDefault f1 f2) (enumFromThenToDefault f1 f2) + +enumSuccDefault f1 f2 x = f1 ((+#) (f2 x) 1) +enumPredDefault f1 f2 x = f1 ((-#) (f2 x) 1) +enumFromToDefault f1 f2 x y = map f1 (enumFromToInt (f2 x) (f2 y)) +enumFromThenToDefault f1 f2 x y z = map f1 (enumFromThenToInt (f2 x) (f2 y) (f2 z)) + +data Ordering = LT | EQ | GT + +showOrdering :: Ordering -> String +showOrdering x = + case x of + LT -> primPackedToString "LT" + EQ -> primPackedToString "EQ" + GT -> primPackedToString "GT" + +compareList ''$dictElem'' xs ys = + case xs of + [] -> + case ys of + (:) yh yt -> LT + _ -> EQ + (:) xh xt -> + case ys of + [] -> GT + (:) yh yt -> + case compare ''$dictElem'' xh yh of + GT -> GT + LT -> LT + EQ -> compareList ''$dictElem'' xt yt + +{- misc -} + +primAppend :: [a] -> [a] -> [a] -- is '++' +primAppend xs ys = + case xs of + { '':[]'' -> ys + ; (:) z zs -> (:) z (primAppend zs ys) + } + +{-------------------------------------------------------------------------- + IO +--------------------------------------------------------------------------} +data Handle + = HandleRead (Channel Input) + | HandleWrite (Channel Output) + +data IOMode + = ReadMode + | WriteMode + | AppendMode + +stdin :: Handle +stdin + = HandleRead stdinChannel + +stdout :: Handle +stdout + = HandleWrite stdoutChannel + +stderr :: Handle +stderr + = HandleWrite stderrChannel + +getChar :: IO Char +getChar + = inputChar stdinChannel -- hGetChar stdin + +openFile :: String -> IOMode -> IO Handle +openFile fpath mode + = case mode of + ReadMode -> bindIO (openInputFile fpath True) (\ch -> return (HandleRead ch)) + WriteMode -> bindIO (openOutputFile fpath True CreateOverwrite) (\ch -> return (HandleWrite ch)) + AppendMode-> bindIO (openOutputFile fpath True CreateIfNotExists) (\ch -> return (HandleWrite ch)) + +hClose :: Handle -> IO () +hClose handle + = case handle of + HandleRead ch -> close ch + HandleWrite ch -> -- Yuck: alleen maar om altijd geflushed te closen.. + catch (bindIO (flush ch) (\_ -> close ch)) + (\exn -> bindIO (catch (close ch) (\_ -> raise exn)) + (\_ -> raise exn)) + +hFlush :: Handle -> IO () +hFlush handle + = case handle of + HandleRead ch -> flush ch + HandleWrite ch -> flush ch + +hGetChar :: Handle -> IO Char +hGetChar handle + = case handle of + HandleRead ch -> inputChar ch + HandleWrite ch -> errorPacked "PreludePrim.hGetChar: Handle is not open for reading" + +hPutChar :: Handle -> Char -> IO () +hPutChar handle c + = case handle of + HandleRead ch -> errorPacked "PreludePrim.hPutChar: Handle is not open for writing" + HandleWrite ch -> outputChar ch c + +hPutString :: Handle -> String -> IO () +hPutString handle s + = case handle of + HandleRead ch -> errorPacked "PreludePrim.hPutString: Handle is not open for writing" + HandleWrite ch -> outputString ch s + +catchEof :: IO a -> IO a -> IO a +catchEof io onEof + = catch io + (\exn -> case exn of + System sysexn -> case sysexn of + EndOfFile -> onEof + _ -> raise exn + _ -> raise exn + ) + diff --git a/lib/simple/Char.hs b/lib/simple/Char.hs new file mode 100644 --- /dev/null +++ b/lib/simple/Char.hs @@ -0,0 +1,33 @@ +module Char where + +isSpace :: Char -> Bool +isSpace c = + i == ord ' ' || i == ord '\t' || i == ord '\n' || + i == ord '\r' || i == ord '\f' || i == ord '\v' + where + i = ord c + +isUpper :: Char -> Bool +isUpper c = ord c >= ord 'A' && ord c <= ord 'Z' + +isLower :: Char -> Bool +isLower c = ord c >= ord 'a' && ord c <= ord 'z' + +isDigit :: Char -> Bool +isDigit c = ord c >= ord '0' && ord c <= ord '9' + +isAlpha :: Char -> Bool +isAlpha c = isUpper c || isLower c + +isAlphaNum :: Char -> Bool +isAlphaNum c = isAlpha c || isDigit c + +toUpper :: Char -> Char +toUpper c + | isLower c = chr ( ord c - ord 'a' + ord 'A' ) + | otherwise = c + +toLower :: Char -> Char +toLower c + | isUpper c = chr ( ord c - ord 'A' + ord 'a' ) + | otherwise = c diff --git a/lib/simple/HeliumLang.core b/lib/simple/HeliumLang.core new file mode 100644 --- /dev/null +++ b/lib/simple/HeliumLang.core @@ -0,0 +1,388 @@ +{- The (type) constructors and functions in this module are + used in the translation of language constructs. +-} + +module HeliumLang + ( Bool(True, False), '':[]''('':[]'', (:)), '':()''('':()''), '':->'' + , String, Int, Float, IO, Char + + , showFunction, showIO, showPolymorphic + , showChar, showString, showInt, showList, showBool, showUnit, showFloat + , showTuple2, showTuple3, showTuple4, showTuple5, showTuple6, showTuple7 + , showTuple8, showTuple9, showTuple10 + + , ''$primPutChar'', ''$primPutStr'', ''$primPutStrLn'' + , ''$primBindIO'', ''$primUnsafePerformIO'' + , ''$primErrorPacked'', ''$primPatternFailPacked'' + , ''$primNegInt'', ''$primNegFloat'', ''$primStringToFloat'', ''$primEqFloat'' + , ''$primConcat'', ''$primConcatMap'' + , ''$primPackedToString'' + + , ''$negate'', ''$floatUnaryMinus'' + , ''$enumFrom'', ''$enumFromThen'', ''$enumFromTo'', ''$enumFromThenTo'' + , ''$show'' , ''$showList'' + ) where + +import LvmLang + ( Int(), Float(), IO() + , custom "typedecl" String + , Bool(True, False) + , '':[]''('':[]'', (:)) + , '':()''('':()'') + , ''$primBindIO'' = bindIO, ''$primReturnIO'' = returnIO + , negInt + , negFloat, ''$primEqFloat'' = (==.) + , (+), (-), (>), (<), (>=), quot, rem, (==) + , stringFromPacked + , unsafePerformIO + ) +import LvmIO + ( stdin, stdout, stderr, flush, outputChar, outputPacked + ) +import LvmException + ( errorPacked + , patternFailPacked + ) + +{---------------------------------------------------------- + Fixities +----------------------------------------------------------} +custom infix (:) : public [5,"right"] + +{-------------------------------------------------------------------------- + built into the language +--------------------------------------------------------------------------} +''$negate'' :: Int -> Int +''$negate'' i = negInt i + +''$floatUnaryMinus'' :: Float -> Float +''$floatUnaryMinus'' f = ''$primNegFloat'' f + +''$show'' :: "showDict -> a -> String" +''$show'' dShow + = errorPacked "internal error: show called in the simple prelude!" + +''$showList'' :: "(a -> String) -> [a] -> String" +''$showList'' = showList + +-- the enumeration functions are used in the translation of the .. notation +-- [1..10] === enumFromTo 1 10 +-- [1..] === enumFrom 1 +-- [1,3..10] === enumFromThenTo 1 3 10 +-- [1,3..] === enumFromThen 1 3 + +''$enumFrom'' :: Int -> [Int] +''$enumFrom'' n = (:) n (''$enumFrom'' ((+) n 1)) + +''$enumFromTo'' :: Int -> Int -> [Int] +''$enumFromTo'' n m = + case (>) n m of + { True -> [] + ; _ -> (:) n (''$enumFromTo'' ((+) n 1) m) + } + +''$enumFromThen'' :: Int -> Int -> [Int] +''$enumFromThen'' n a = (:) n (''$enumFromThen'' a ((+) a ((-) a n))) + +''$enumFromThenTo'' :: Int -> Int -> Int -> [Int] +''$enumFromThenTo'' n a m = + case (>) a n of + { True -> ''$primAscendToWithStep'' n m ((-) a n) + ; _ -> ''$primDescendToWithStep'' n m ((-) a n) + } + +{---------------------------------------------------------- + Basic data types +----------------------------------------------------------} +data '':->'' x y +-- Daan has type Char = Int +data Char + +''$primPackedToString'' :: PackedString -> String +''$primPackedToString'' p + = stringFromPacked p + +''$primUnsafePerformIO'' :: IO a -> a +''$primUnsafePerformIO'' io + = unsafePerformIO io + +''$primPatternFailPacked'' :: PackedString -> a +''$primPatternFailPacked'' p + = patternFailPacked p + +''$primErrorPacked'' :: PackedString -> a +''$primErrorPacked'' p + = errorPacked p + + +''$primPutChar'' :: Char -> IO () +''$primPutChar'' c = + ''$primBindIO'' + (outputChar stdout c) + (flush stdout) + +''$primPutChars'' :: String -> IO () +''$primPutChars'' xs = + case xs of { + '':[]'' -> ''$primReturnIO'' '':()'' ; + (:) y ys -> ''$primBindIO'' + (''$primPutChar'' y) -- if you don't want to flush each character: (outputChar stdout y) + (''$primPutChars'' ys) } + +''$primPutStr'' :: String -> IO () +''$primPutStr'' xs = + ''$primBindIO'' + (''$primPutChars'' xs) + (flush stdout) + +''$primPutStrLn'' :: String -> IO () +''$primPutStrLn'' xs = + ''$primBindIO'' + (''$primPutChars'' xs) + (''$primPutChar'' '\n') -- does the flush + +''$primNegInt'' :: Int -> Int! +''$primNegInt'' = negInt + +''$primConcat'' :: [[a]] -> [a] +''$primConcat'' xss = + case xss of + { '':[]'' -> [] + ; (:) ys yss -> ''$primAppend'' ys (''$primConcat'' yss) + } + +''$primConcatMap'' :: (a -> [b]) -> [a] -> [b] +''$primConcatMap'' f xs = + case xs of + { '':[]'' -> [] + ; (:) y ys -> ''$primAppend'' (f y) (''$primConcatMap'' f ys) + } + +''$primAppend'' :: [a] -> [a] -> [a] -- is '++' +''$primAppend'' xs ys = + case xs of + { '':[]'' -> ys + ; (:) z zs -> (:) z (''$primAppend'' zs ys) + } + + +''$primAscendToWithStep'' :: Int -> Int -> Int -> [Int] +''$primAscendToWithStep'' n m step = + case (>) n m of + { True -> [] + ; _ -> (:) n (''$primAscendToWithStep'' ((+) n step) m step) + } + + +''$primDescendToWithStep'' :: Int -> Int -> Int -> [Int] +''$primDescendToWithStep'' n m step = + case (<) n m of + { True -> [] + ; _ -> (:) n (''$primDescendToWithStep'' ((+) n step) m step) + } + + +-- Show + +showBool :: Bool -> String +showBool b = + case b of + { True -> stringFromPacked "True" + ; _ -> stringFromPacked "False" + } + +showUnit :: () -> String +showUnit u = + case u of + { '':()'' -> stringFromPacked "()" + } + +showFunction :: (a -> String) -> (b -> String) -> (a->b) -> String +showFunction a b x = let! x = x in stringFromPacked "<>" + +showIO :: (a -> String) -> IO a -> String +showIO a x = let! x = x in stringFromPacked "<>" + +showChar :: Char -> String +showChar c = + (:) '\'' (''$primAppend'' (safeShowChar True c) + [ '\'' ]) + +safeShowChar :: Bool -> Char -> String +safeShowChar inChar c = + case c of + { '\a' -> stringFromPacked "\\a" + ; '\b' -> stringFromPacked "\\b" + ; '\f' -> stringFromPacked "\\f" + ; '\n' -> stringFromPacked "\\n" + ; '\r' -> stringFromPacked "\\r" + ; '\t' -> stringFromPacked "\\t" + ; '\\' -> stringFromPacked "\\\\" + ; '\'' -> case inChar of { True -> stringFromPacked "\\'" + ; _ -> [c] + } + ; '\"' -> case inChar of { True -> [c] + ; _ -> stringFromPacked "\\\"" + } + ; _ -> + case logicalAnd ((>=) c 32) ((<) c 127) of + { True -> [c] + ; _ -> (:) '\\' (showInt c) + } + } + +logicalAnd :: Bool -> Bool -> Bool +logicalAnd b1 b2 = + case b1 of + { True -> b2 + ; _ -> False + } + +showString :: String -> String +showString s = + (:) '\"' (''$primAppend'' (''$primConcatMap'' (safeShowChar False) s) + (stringFromPacked "\"")) + +showInt :: Int -> String +showInt n = + case (<) n 0 of + { True -> (:) '(' ((:) '-' + (''$primAppend'' + (showPositiveInt (''$primNegInt'' n)) + (stringFromPacked ")") + )) + ; _ -> showPositiveInt n + } + +showPositiveInt :: Int -> String +showPositiveInt i = + let + rest = quot i 10 + digit = [ (+) '0' (rem i 10) ] + in + case (==) rest 0 of + { True -> digit + ; _ -> ''$primAppend'' (showPositiveInt rest) digit + } + +showList :: (a -> String) -> [a] -> String +showList showElem list = + ''$primConcat'' [ ['['], commaList (''$primMap'' showElem list), [']'] ] + +''$primMap'' f xs = + case xs of + { '':[]'' -> [] + ; (:) y ys -> (:) (f y) (''$primMap'' f ys) + } + +showPolymorphic :: a -> String +showPolymorphic x = + let! x = x in stringFromPacked "<>" + +showTuple2 s1 s2 t : public [custom "type" ["(a -> String) -> (b -> String) -> (a, b) -> String" ]] = + case t of + (@0, 2) x1 x2 -> + showTupleList [ s1 x1, s2 x2 ] + +showTuple3 s1 s2 s3 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (a, b, c) -> String" ]] = + case t of + (@0, 3) x1 x2 x3 -> + showTupleList [ s1 x1, s2 x2, s3 x3 ] + +showTuple4 s1 s2 s3 s4 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (a, b, c, d) -> String" ]] = + case t of + (@0, 4) x1 x2 x3 x4 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4 ] + +showTuple5 s1 s2 s3 s4 s5 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (a, b, c, d, e) -> String" ]] = + case t of + (@0, 5) x1 x2 x3 x4 x5 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5 ] + +showTuple6 s1 s2 s3 s4 s5 s6 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (f -> String) -> (a, b, c, d, e, f) -> String" ]] = + case t of + (@0, 6) x1 x2 x3 x4 x5 x6 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5, s6 x6 ] + +showTuple7 s1 s2 s3 s4 s5 s6 s7 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (f -> String) -> (g -> String) -> (a, b, c, d, e, f, g) -> String" ]] = + case t of + (@0, 7) x1 x2 x3 x4 x5 x6 x7 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5, s6 x6, s7 x7 ] + +showTuple8 s1 s2 s3 s4 s5 s6 s7 s8 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (f -> String) -> (g -> String) -> (h -> String) -> (a, b, c, d, e, f, g, h) -> String" ]] = + case t of + (@0, 8) x1 x2 x3 x4 x5 x6 x7 x8 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5, s6 x6, s7 x7, s8 x8 ] + +showTuple9 s1 s2 s3 s4 s5 s6 s7 s8 s9 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (f -> String) -> (g -> String) -> (h -> String) -> (i -> String) -> (a, b, c, d, e, f, g, h, i) -> String" ]] = + case t of + (@0, 9) x1 x2 x3 x4 x5 x6 x7 x8 x9 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5, s6 x6, s7 x7, s8 x8, s9 x9 ] + +showTuple10 s1 s2 s3 s4 s5 s6 s7 s8 s9 s10 t : public [custom "type" ["(a -> String) -> (b -> String) -> (c -> String) -> (d -> String) -> (e -> String) -> (f -> String) -> (g -> String) -> (h -> String) -> (i -> String) -> (j -> String) -> (a, b, c, d, e, f, g, h, i, j) -> String" ]]= + case t of + (@0, 10) x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 -> + showTupleList [ s1 x1, s2 x2, s3 x3, s4 x4, s5 x5, s6 x6, s7 x7, s8 x8, s9 x9, s10 x10 ] + +showTupleList :: [String] -> String +showTupleList xs = + ''$primConcat'' [ ['('], commaList xs, [')'] ] + +commaList :: [String] -> String +commaList list = + case list of + { '':[]'' -> [] + ; (:) x xs -> + case xs of + { '':[]'' -> x + ; _ -> ''$primAppend'' x (''$primConcatMap'' (''$primAppend'' [ ',' ]) xs) + } + } + +-- Float + +''$primNegFloat'' :: Float -> Float! +''$primNegFloat'' = negFloat + +''$primStringToFloat'' :: String -> Float +''$primStringToFloat'' = float_of_string_extern + +extern float_of_string_extern "float_of_string" :: "Fz" + +''$primShowFloat'' :: Float -> String +''$primShowFloat'' x = let! x = x in stringFromPacked (stringFromFloat x 6 'g') + +extern stringFromFloat "string_of_float" :: "aFII" + +showFloat : public [custom "type" ["Float -> String"]] + = \f -> safeMinus (addPointZero (''$primShowFloat'' f)) + +safeMinus : private [custom "type" ["String -> String"]] + = \s -> + case s of + { (:) x xs -> + case x of + { '-' -> ''$primAppend'' (stringFromPacked "(-.") (''$primAppend'' xs (stringFromPacked ")")) + ; _ -> s + } + ; _ -> s + } + +addPointZero : private [custom "type" ["String -> String"]] + = \s -> + case hasPointOrE s of + { True -> s + ; _ -> ''$primAppend'' s (stringFromPacked ".0") + } + +hasPointOrE : private [] + = \xs -> + case xs of + { [] -> False + ; (:) y ys -> + case y of + { '.' -> True + ; 'e' -> True + ; _ -> hasPointOrE ys + } + } diff --git a/lib/simple/List.hs b/lib/simple/List.hs new file mode 100644 --- /dev/null +++ b/lib/simple/List.hs @@ -0,0 +1,116 @@ +----------------------------------------------------------------------------- +-- Standard Library: List operations +-- +-- Suitable for use with Helium +----------------------------------------------------------------------------- + +module List where + +import Maybe + +find :: (a -> Bool) -> [a] -> Maybe a +find p = listToMaybe . filter p + +findIndex :: (a -> Bool) -> [a] -> Maybe Int +findIndex p = listToMaybe . findIndices p + +findIndices :: (a -> Bool) -> [a] -> [Int] +findIndices p xs = [ i | (x,i) <- zip xs [0..], p x ] + +nubBy :: (a -> a -> Bool) -> [a] -> [a] +nubBy _ [] = [] +nubBy eq (x:xs) = x : nubBy eq (filter (\y -> not (eq x y)) xs) + +deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] +deleteBy _ _ [] = [] +deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys + +deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] +deleteFirstsBy eq = foldl (flip (deleteBy eq)) + +unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] +unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs + +intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] +intersectBy eq xs ys = [x | x <- xs, any (eq x) ys] + +intersperse :: a -> [a] -> [a] +intersperse _ [] = [] +intersperse _ [x] = [x] +intersperse sep (x:xs) = x : sep : intersperse sep xs + +transpose :: [[a]] -> [[a]] +transpose [] = [] +transpose ([] : xss) = transpose xss +transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : + transpose (xs : [ t | (_:t) <- xss]) + +partition :: (a -> Bool) -> [a] -> ([a],[a]) +partition p xs = foldr select ([],[]) xs + where select x (ts,fs) | p x = (x:ts,fs) + | otherwise = (ts,x:fs) + +-- groupBy splits its list argument into a list of lists of equal, adjacent +-- elements. e.g., +-- groupBy "Mississippi" == ["M","i","ss","i","ss","i","pp","i"] + +groupBy :: (a -> a -> Bool) -> [a] -> [[a]] +groupBy _ [] = [] +groupBy eq (x:xs) = (x:ys) : groupBy eq zs + where (ys,zs) = span (eq x) xs + +-- inits xs returns the list of initial segments of xs, shortest first. +-- e.g., inits "abc" == ["","a","ab","abc"] +inits :: [a] -> [[a]] +inits [] = [[]] +inits (x:xs) = [[]] ++ map (\ys -> x:ys) (inits xs) + +-- tails xs returns the list of all final segments of xs, longest first. +-- e.g., tails "abc" == ["abc", "bc", "c",""] +tails :: [a] -> [[a]] +tails [] = [[]] +tails xxs@(_:xs) = xxs : tails xs + +mapAccumL :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c]) +mapAccumL _ s [] = (s, []) +mapAccumL f s (x:xs) = (s'',y:ys) + where (s', y ) = f s x + (s'',ys) = mapAccumL f s' xs + +mapAccumR :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c]) +mapAccumR _ s [] = (s, []) +mapAccumR f s (x:xs) = (s'', y:ys) + where (s'',y ) = f s' x + (s', ys) = mapAccumR f s xs + +unfoldr :: (b -> Maybe (a,b)) -> b -> [a] +unfoldr f b = case f b of Nothing -> [] + Just (a,c) -> a : unfoldr f c + +sortBy :: (a -> a -> Ordering) -> [a] -> [a] +sortBy cmp = foldr (insertBy cmp) [] + +insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a] +insertBy _ x [] = [x] +insertBy cmp x ys@(y:ys') + = case cmp x y of + GT -> y : insertBy cmp x ys' + _ -> x : ys + +maximumBy :: (a -> a -> Ordering) -> [a] -> a +maximumBy _ [] = error "List.maximumBy: empty list" +maximumBy cmp xs = foldl1 maxBy xs + where + maxBy x y = case cmp x y of + GT -> x + _ -> y + +minimumBy :: (a -> a -> Ordering) -> [a] -> a +minimumBy _ [] = error "List.minimumBy: empty list" +minimumBy cmp xs = foldl1 minBy xs + where + minBy x y = case cmp x y of + GT -> y + _ -> x + +----------------------------------------------------------------------------- diff --git a/lib/simple/LvmException.core b/lib/simple/LvmException.core new file mode 100644 --- /dev/null +++ b/lib/simple/LvmException.core @@ -0,0 +1,123 @@ +---------------------------------------------------------------- +-- Daan Leijen (c) 2001 +-- +-- $Revision: 285 $ +-- $Author: uust $ +-- $Date: 2004-02-14 15:46:23 +0100 (Sat, 14 Feb 2004) $ +---------------------------------------------------------------- +module LvmException( Exception(..), RuntimeException(..), SystemException(..) + , ArithmeticException(..), SignalException(..) + , catch, raise, error, errorPacked, patternFail, patternFailPacked + ) where + +import LvmLang( packedFromString ) + +instruction primCatch "catch" :: (Exception -> a) -> a -> a +instruction primRaise "raise" :: Exception! -> a + + +{---------------------------------------------------------- + Exception and Signals +----------------------------------------------------------} +data Exception + = HeapOverflow -- heap overflow + | StackOverflow Int -- stack overflow + | Signal SignalException -- interrupt occurred + | Runtime RuntimeException -- runtime system exception + | Arithmetic ArithmeticException -- arithmetic exception + | System SystemException -- operating system exceptions + | InvalidArgument PackedString -- invalid argument passed + | Assert PackedString -- assertion failed + | NotFound -- no object is found + | UserError PackedString -- general failure (raised by "error") + +data RuntimeException + = PatternFailure PackedString -- pattern match failure + | NonTermination PackedString -- non terminating program + | OutOfBounds PackedString -- field access out of bounds + | Exit Int -- exiting program + | InvalidOpcode Int -- invalid opcode + | LoadError PackedString PackedString -- runtime loader exception + | RuntimeError PackedString -- general failure + +data SystemException + = EndOfFile -- end of input reached + | BlockedOnIO -- blocked I/O channel + | SystemError Int PackedString -- general system error + +data ArithmeticException + = FloatInvalid -- float invalid operation + | FloatDivideByZero -- float division by zero + | FloatOverflow -- float has overflowed + | FloatUnderflow -- float has underflowed + | FloatInexact -- float result is inexact + | FloatDenormal -- denormalized float value + | DivideByZero -- integer division by zero + | Overflow -- integer overflow + | Underflow -- integer underflow + | InvalidOperation -- general arithmetic error + | UnEmulated -- cannot emulate float instruction + | NegativeSquareRoot -- square root of negative number + | FloatStackOverflow -- float hardware stack has overflowed + | FloatStackUnderflow -- float hardware stack has underflowed + +data SignalException + = SignalNone -- runtime: no signal + | SignalGarbageCollect -- runtime: GC needed + | SignalYield -- runtime: thread should yield + | SignalLost -- runtime: lost signal + | SignalKeyboard -- interactive interrupt (ctrl-c) + | SignalKeyboardStop -- interactive stop (ctrl-break) + | SignalFloatException -- floating point exception + | SignalSegmentationViolation -- invalid memory reference + | SignalIllegalInstruction -- illegal hardware instruction + | SignalAbort -- abnormal termination + | SignalTerminate -- termination + | SignalKill -- termination (can not be ignored) + | SignalKeyboardTerminate -- interactive termination + | SignalAlarm -- timeout + | SignalVirtualAlarm -- timeout in virtual time + | SignalBackgroundRead -- terminal read from background process + | SignalBackgroundWrite -- terminal write from background process + | SignalContinue -- continue process + | SignalLostConnection -- connection lost + | SignalBrokenPipe -- open ended pipe + | SignalProcessStatusChanged -- child process terminated + | SignalStop -- stop process + | SignalProfiler -- profiling interrupt + | SignalUser1 -- application defined signal 1 + | SignalUser2 -- application defined signal 2 + + +{---------------------------------------------------------- + raise and catch +----------------------------------------------------------} +raise :: Exception -> a +raise exn + = let! exn = exn in primRaise exn + +catch :: IO a -> (Exception -> IO a) -> IO a +catch action handler + = \_ -> primCatch (\exn -> handler exn ()) (action ()) + +{---------------------------------------------------------- + user errors +----------------------------------------------------------} +error :: String -> a +error msg + = let! s = (packedFromString msg) in raise (UserError s) + +errorPacked :: PackedString -> a +errorPacked msg + = raise (UserError msg) + +patternFail :: String -> a +patternFail msg + = let! s = packedFromString msg + exn = PatternFailure s + in raise (Runtime exn) + +patternFailPacked :: PackedString -> a +patternFailPacked msg + = let! exn = PatternFailure msg + in raise (Runtime exn) diff --git a/lib/simple/LvmIO.core b/lib/simple/LvmIO.core new file mode 100644 --- /dev/null +++ b/lib/simple/LvmIO.core @@ -0,0 +1,160 @@ +---------------------------------------------------------------- +-- Daan Leijen (c) 2001 +-- +-- $Revision: 252 $ +-- $Author: uust $ +-- $Date: 2004-01-14 16:47:22 +0100 (Wed, 14 Jan 2004) $ +---------------------------------------------------------------- +module LvmIO( Input, Output, Channel, Descriptor + , stdin, stdout, stderr + , flush, close + , outputChar, outputPacked, outputString + , inputChar + , CreateMode(..), openInputFile, openOutputFile + ) where + +import LvmLang( primIO, packedLength, packedFromString, bindIO, unsafePerformStrictIO, False, True ) + +{---------------------------------------------------------- + Primitive I/O operations +----------------------------------------------------------} +extern prim_open :: "IzII" +extern prim_close :: "vI" +extern prim_flag_mask :: "II" +extern prim_input_flags :: "II" +extern prim_output_flags :: "III" + +extern prim_open_descriptor :: "aIb" +extern prim_close_channel :: "va" +extern prim_set_binary_mode :: "vab" +extern prim_flush_partial :: "ba" +extern prim_flush :: "va" +extern prim_output_char :: "vac" +extern prim_output :: "vazll" +extern prim_input_char :: "Ia" + + +{---------------------------------------------------------- + Channels +----------------------------------------------------------} +data Input +data Output +data Channel a +type Descriptor = Int + + +{---------------------------------------------------------- + Private helpers +----------------------------------------------------------} +primOpenInputDescriptor :: Descriptor -> Channel Input +primOpenInputDescriptor fd + = let! fd = fd in prim_open_descriptor fd False + +primOpenOutputDescriptor :: Descriptor -> Channel Output +primOpenOutputDescriptor fd + = let! fd = fd in prim_open_descriptor fd True + + +{---------------------------------------------------------- + Files +----------------------------------------------------------} +data CreateMode + = CreateNever -- don't create a new file, and append writes + | CreateIfNotExists -- create one if none exists yet, append otherwise + | CreateExclusive -- create if none exists, but fail if a file exists + | CreateOverwrite -- destroy previous file, and create a new one + +{---------------------------------------------------------- + Private file operations +----------------------------------------------------------} +data OpenFlag + = OpenReadOnly + | OpenWriteOnly + | OpenCreate + | OpenTruncate + | OpenExclusive + | OpenBinary + | OpenText + | OpenNonBlocking + +primOpenInputFile :: FilePath -> Bool -> Channel Input +primOpenInputFile fpath asText + = let! b = asText + m = prim_input_flags b + fname = packedFromString fpath + fd = prim_open fname m 0o744 + in primOpenInputDescriptor fd + +primOpenOutputFile :: FilePath -> Bool -> CreateMode -> Channel Output +primOpenOutputFile fpath asText cmode + = let! b = asText + c = cmode + m = prim_output_flags b c + fname = packedFromString fpath + fd = prim_open fname m 0o744 + in primOpenOutputDescriptor fd + + +{---------------------------------------------------------- + Channel I/O, based on the OCaml interface +----------------------------------------------------------} +stdin :: Channel Input +stdin + = primOpenInputDescriptor 0 + +stdout :: Channel Output +stdout + = primOpenOutputDescriptor 1 + +stderr :: Channel Output +stderr + = primOpenOutputDescriptor 2 + +openInputFile :: FilePath -> Bool -> IO (Channel Input) +openInputFile fpath asText + = let action _ = primOpenInputFile fpath asText + in primIO action + +openOutputFile :: FilePath -> Bool -> CreateMode -> IO (Channel Output) +openOutputFile fpath asText createMode + = let action _ = primOpenOutputFile fpath asText createMode + in primIO action + +{-------------------------------------------------------------------------- + Channel operations +--------------------------------------------------------------------------} +flush :: Channel Output -> IO () +flush out + = let action _ = (let! out = out in prim_flush out) + in primIO action + +close :: Channel a -> IO () +close chan + = let action _ = (let! chan = chan in prim_close_channel chan) + in primIO action + +outputChar :: Channel Output -> Char -> IO () +outputChar out c + = let action _ = let! out = out + c = c + in prim_output_char out c + in primIO action + +inputChar :: Channel Input -> IO Char +inputChar inp + = let action _ = let! inp = inp in prim_input_char inp + in primIO action + + +outputPacked :: Channel Output -> PackedString -> IO () +outputPacked chan s + = let action _ = let! chan = chan + s = s + len = packedLength s + in prim_output chan s 0 len + in primIO action + +-- TODO: use direct I/O primitive for strings +outputString :: Channel Output -> String -> IO () +outputString chan s + = outputPacked chan (packedFromString s) diff --git a/lib/simple/LvmLang.core b/lib/simple/LvmLang.core new file mode 100644 --- /dev/null +++ b/lib/simple/LvmLang.core @@ -0,0 +1,327 @@ +---------------------------------------------------------------- +-- Daan Leijen (c) 2001 +-- +-- $Revision: 239 $ +-- $Author: uust $ +-- $Date: 2004-01-12 17:41:17 +0100 (Mon, 12 Jan 2004) $ +---------------------------------------------------------------- +module LvmLang + ( Bytes, Int, Float + , Bool(True, False), '':[]''('':[]'', (:)), '':()''('':()'') + , IO, Char, Double, PackedString, String + + , packedFromString, stringFromPacked, packedLength + , ($!), seq + + -- IO + , bindIO, returnIO + , primIO, unsafePerformIO, unsafePerformStrictIO + + -- Int + , (+), (-), (*), (/), (%), quot, rem + , and, xor, or, shr, shl, shrNat, negInt + , (==), (/=), (<), (>), (<=), (>=) + + -- Float + , (+.), (-.), (*.), (/.), negFloat + , (==.), (/=.), (<.), (>.), (<=.), (>=.) + + ) where + +{---------------------------------------------------------- + Instructions +----------------------------------------------------------} +instruction primAddInt "addint" :: Int! -> Int! -> Int! +instruction primSubInt "subint" :: Int! -> Int! -> Int! +instruction primMulInt "mulint" :: Int! -> Int! -> Int! +instruction primDivInt "divint" :: Int! -> Int! -> Int! +instruction primModInt "modint" :: Int! -> Int! -> Int! +instruction primQuotInt "quotint":: Int! -> Int! -> Int! +instruction primRemInt "remint" :: Int! -> Int! -> Int! +instruction primAndInt "andint" :: Int! -> Int! -> Int! +instruction primXorInt "xorint" :: Int! -> Int! -> Int! +instruction primOrInt "orint" :: Int! -> Int! -> Int! +instruction primShrInt "shrint" :: Int! -> Int! -> Int! +instruction primShlInt "shlint" :: Int! -> Int! -> Int! +instruction primShrNat "shrnat" :: Int! -> Int! -> Int! +instruction primNegInt "negint" :: Int! -> Int! + +instruction primEqInt "eqint" :: Int! -> Int! -> Bool! +instruction primNeInt "neint" :: Int! -> Int! -> Bool! +instruction primLtInt "ltint" :: Int! -> Int! -> Bool! +instruction primGtInt "gtint" :: Int! -> Int! -> Bool! +instruction primLeInt "leint" :: Int! -> Int! -> Bool! +instruction primGeInt "geint" :: Int! -> Int! -> Bool! + +instruction primAddFloat "addfloat" :: Float! -> Float! -> Float! +instruction primSubFloat "subfloat" :: Float! -> Float! -> Float! +instruction primMulFloat "mulfloat" :: Float! -> Float! -> Float! +instruction primDivFloat "divfloat" :: Float! -> Float! -> Float! +instruction primNegFloat "negfloat" :: Float! -> Float! + +instruction primEqFloat "eqfloat" :: Float! -> Float! -> Bool! +instruction primNeFloat "nefloat" :: Float! -> Float! -> Bool! +instruction primLtFloat "ltfloat" :: Float! -> Float! -> Bool! +instruction primGtFloat "gtfloat" :: Float! -> Float! -> Bool! +instruction primLeFloat "lefloat" :: Float! -> Float! -> Bool! +instruction primGeFloat "gefloat" :: Float! -> Float! -> Bool! + +instruction primAlloc "alloc" :: Int! {- tag -} -> Int! {- size -} -> a! +instruction primGetTag "gettag" :: a! -> Int! +instruction primGetSize "getsize":: a! -> Int! +-- instruction primNew "new" :: Int! {- tag -} -> Int! {- size -} -> {- x_1 ... x_n -> -} a! +-- instruction primPack "pack" :: a! -> Int! {- size -} -> {- x_1 ... x_size -} () +-- instruction primUnPack "unpack" :: a! -> (# x_1 ... x_size #) + +extern prim_chars_of_string :: "aa" +extern prim_string_of_chars :: "ala" +extern prim_string_length :: "la" + +{---------------------------------------------------------- + Basic data types +----------------------------------------------------------} +data Bytes +data Int +data Float +data Bool = False -- tag 0 + | True -- tag 1 + +{- +Be aware that de definition +data Bool = True -- tag 0 + | False -- tag 1 +is not allowed because the instructions +eqint, neint etc. assume False has tag 0 +and True has tag 1. +-} + +data '':[]'' a = '':[]'' | (:) a [a] +data '':()'' = '':()'' + +data IORes a = IORes a +data IO a -- = () -> IORes a + +{---------------------------------------------------------- + Type definitions +----------------------------------------------------------} +type Char = Int +type Double = Float + +type PackedString = Bytes +type String = [Char] + + +{---------------------------------------------------------- + Strictness +----------------------------------------------------------} +($!) :: (a -> b) -> a -> b +($!) f x = let! x = x in f x + +seq :: a -> b -> b +seq x y = let! x = x in y + +{---------------------------------------------------------- + Basic arithmetic on Int's +----------------------------------------------------------} +(+) :: Int -> Int -> Int! +(+) x y = let! y = y in let! x = x in primAddInt x y + +(-) :: Int -> Int -> Int! +(-) x y = let! y = y in let! x = x in primSubInt x y + +(*) :: Int -> Int -> Int! +(*) x y = let! y = y in let! x = x in primMulInt x y + +(/) :: Int -> Int -> Int! +(/) x y = let! y = y in let! x = x in primDivInt x y + +(%) :: Int -> Int -> Int! +(%) x y = let! y = y in let! x = x in primModInt x y + +quot :: Int -> Int -> Int! +quot x y = let! y = y in let! x = x in primQuotInt x y + +rem :: Int -> Int -> Int! +rem x y = let! y = y in let! x = x in primRemInt x y + +and :: Int -> Int -> Int! +and x y = let! y = y in let! x = x in primAndInt x y + +xor :: Int -> Int -> Int! +xor x y = let! y = y in let! x = x in primXorInt x y + +or :: Int -> Int -> Int! +or x y = let! y = y in let! x = x in primOrInt x y + +shr :: Int -> Int -> Int! +shr x y = let! y = y in let! x = x in primShrInt x y + +shl :: Int -> Int -> Int! +shl x y = let! y = y in let! x = x in primShlInt x y + +shrNat :: Int -> Int -> Int! +shrNat x y = let! y = y in let! x = x in primShrNat x y + +negInt :: Int -> Int! +negInt x = let! x = x in primNegInt x + +{---------------------------------------------------------- + Comparisons on Int's +----------------------------------------------------------} +(==) :: Int -> Int -> Bool! +(==) x y = let! y = y in let! x = x in primEqInt x y + +(/=) :: Int -> Int -> Bool! +(/=) x y = let! y = y in let! x = x in primNeInt x y + +(<) :: Int -> Int -> Bool! +(<) x y = let! y = y in let! x = x in primLtInt x y + +(>) :: Int -> Int -> Bool! +(>) x y = let! y = y in let! x = x in primGtInt x y + +(<=) :: Int -> Int -> Bool! +(<=) x y = let! y = y in let! x = x in primLeInt x y + +(>=) :: Int -> Int -> Bool! +(>=) x y = let! y = y in let! x = x in primGeInt x y + +{---------------------------------------------------------- + Basic arithmetic on Float's +----------------------------------------------------------} +(+.) :: Float -> Float -> Float! +(+.) x y = let! y = y in let! x = x in primAddFloat x y + +(-.) :: Float -> Float -> Float! +(-.) x y = let! y = y in let! x = x in primSubFloat x y + +(*.) :: Float -> Float -> Float! +(*.) x y = let! y = y in let! x = x in primMulFloat x y + +(/.) :: Float -> Float -> Float! +(/.) x y = let! y = y in let! x = x in primDivFloat x y + +negFloat :: Float -> Float! +negFloat x = let! x = x in primNegFloat x + +{---------------------------------------------------------- + Comparisons on Float's +----------------------------------------------------------} +(==.) :: Float -> Float -> Bool! +(==.) x y = let! y = y in let! x = x in primEqFloat x y + +(/=.) :: Float -> Float -> Bool! +(/=.) x y = let! y = y in let! x = x in primNeFloat x y + +(<.) :: Float -> Float -> Bool! +(<.) x y = let! y = y in let! x = x in primLtFloat x y + +(>.) :: Float -> Float -> Bool! +(>.) x y = let! y = y in let! x = x in primGtFloat x y + +(<=.) :: Float -> Float -> Bool! +(<=.) x y = let! y = y in let! x = x in primLeFloat x y + +(>=.) :: Float -> Float -> Bool! +(>=.) x y = let! y = y in let! x = x in primGeFloat x y + +{---------------------------------------------------------- + Boolean expressions +----------------------------------------------------------} +(&&) :: Bool -> Bool -> Bool +(&&) x y + = case x of + False -> False + True -> y + + +(||) :: Bool -> Bool -> Bool +(||) x y + = case x of + True -> True + False -> y + +not :: Bool -> Bool +not x + = case x of + True -> False + False -> True + +{---------------------------------------------------------- + Packed strings +----------------------------------------------------------} +stringFromPacked :: PackedString -> String +stringFromPacked packed + = let! packed = packed in prim_chars_of_string packed + +packedFromString :: String -> PackedString +packedFromString s + = let forced s = case s of + [] -> [] + (:) x xs -> let! y = x + ys = forced xs + in (:) y ys + length n s = case s of + [] -> n + (:) x xs -> let! m = (+) n 1 + in length m xs + in let! fs = forced s + len = length 0 fs + in prim_string_of_chars len fs + + + {- + let forceLength n xs = case xs of + (:) x xx -> seq x (forceLength ((+) n 1) xx) + [] -> n + in let! len = forceLength 0 s + t = s + in prim_string_of_chars len t + -} + +packedLength :: PackedString -> Int +packedLength s + = let! s = s in prim_string_length s + +{---------------------------------------------------------- + List helpers +----------------------------------------------------------} +{- +length :: [a] -> Int +length xs + = foldlStrict (+) 0 xs + +foldlStrict :: (b -> a -> b) -> b -> [a] -> b +foldlStrict f z xs + = case xs of + (:) x xx -> case f z x of + z -> foldlStrict f z xx + [] -> z +-} + + +{---------------------------------------------------------- + The IO monad +----------------------------------------------------------} +bindIO :: IO a -> (a -> IO b) -> IO b +bindIO io f + = \_ -> case io () of + IORes x -> f x () + +returnIO :: a -> IO a +returnIO x + = \_ -> IORes x + +primIO :: (() -> a) -> IO a +primIO f + = \_ -> let! x = f () in IORes x + +unsafePerformIO :: IO a -> a +unsafePerformIO io + = case io () of + IORes x -> x + +-- used to execute "main" +unsafePerformStrictIO :: IO a -> a +unsafePerformStrictIO io + = let! x = unsafePerformIO io in x diff --git a/lib/simple/Makefile b/lib/simple/Makefile new file mode 100644 --- /dev/null +++ b/lib/simple/Makefile @@ -0,0 +1,24 @@ + +COREASM=coreasm +HELIUM=helium + +.PHONY : all +.SUFFIXES : .core .lvm .o + +CORESRC = LvmLang.core LvmIO.core LvmException.core \ + HeliumLang.core PreludePrim.core + +HELIUMSRC = Prelude.hs List.hs Maybe.hs Char.hs + +LIBRARIES = $(patsubst %.core,%.lvm,$(CORESRC)) \ + $(patsubst %.hs,%.o,$(HELIUMSRC)) + +all : $(LIBRARIES) + echo $(LIBRARIES) + +%.lvm : %.core + $(COREASM) $< + +%.o : %.hs + "$(HELIUM)" -b --no-overloading $< + diff --git a/lib/simple/Maybe.hs b/lib/simple/Maybe.hs new file mode 100644 --- /dev/null +++ b/lib/simple/Maybe.hs @@ -0,0 +1,39 @@ +----------------------------------------------------------------------------- +-- Standard Library: Operations on the Maybe datatype +-- +-- Suitable for use with Helium +----------------------------------------------------------------------------- + +module Maybe where + +isJust :: Maybe a -> Bool +isJust (Just _) = True +isJust Nothing = False + +isNothing :: Maybe a -> Bool +isNothing Nothing = True +isNothing (Just _) = False + +fromJust :: Maybe a -> a +fromJust (Just a) = a +fromJust Nothing = error "Maybe.fromJust: Nothing" + +fromMaybe :: a -> Maybe a -> a +fromMaybe d Nothing = d +fromMaybe _ (Just a) = a + +maybeToList :: Maybe a -> [a] +maybeToList Nothing = [] +maybeToList (Just a) = [a] + +listToMaybe :: [a] -> Maybe a +listToMaybe [] = Nothing +listToMaybe (a:_) = Just a + +catMaybes :: [Maybe a] -> [a] +catMaybes ms = [ m | Just m <- ms ] + +mapMaybe :: (a -> Maybe b) -> [a] -> [b] +mapMaybe f = catMaybes . map f + +----------------------------------------------------------------------------- diff --git a/lib/simple/Prelude.hs b/lib/simple/Prelude.hs new file mode 100644 --- /dev/null +++ b/lib/simple/Prelude.hs @@ -0,0 +1,775 @@ +{- The Simple (non-overloaded) Standard Prelude for the Helium Compiler -} + +module Prelude where + +import PreludePrim + +infixr 9 . +infixl 9 !! +infixr 8 ^, ^. -- , **. +-- infixl 7 *, *., `quot`, `rem`, `div`, `mod`, /., / [PreludePrim] +-- infixl 6 +, -, +., -. [PreludePrim] +infixr 5 ++ +-- infixr 5 : [HeliumLang] +-- infix 4 ==, /=, <=, <, >, >=, ==., /=., <=., <., >., >=. [PreludePrim] +infixr 3 && +infixr 2 || +infixr 0 $ --, $! [PreludePrim] + +{----------------------------------------------- + -- Int + -----------------------------------------------} + +{- imported from PreludePrim + +(+) :: Int -> Int -> Int +(-) :: Int -> Int -> Int +(*) :: Int -> Int -> Int + +-} + +-- for compatibility with Haskell textbooks +type Integer = Int + +(/) :: Int -> Int -> Int +(/) = div + +{- imported from PreludePrim + +(<) :: Int -> Int -> Bool +(<=) :: Int -> Int -> Bool +(>) :: Int -> Int -> Bool +(>=) :: Int -> Int -> Bool +(==) :: Int -> Int -> Bool +(/=) :: Int -> Int -> Bool +rem :: Int -> Int -> Int +div :: Int -> Int -> Int +mod :: Int -> Int -> Int +quot :: Int -> Int -> Int +negate :: Int -> Int +-} + +max :: Int -> Int -> Int +max x y = if x < y then y else x + +min :: Int -> Int -> Int +min x y = if x < y then x else y + +abs :: Int -> Int +abs x = if x < 0 then - x else x + +absFloat :: Float -> Float +absFloat x = if x <. 0.0 then -. x else x + +signum :: Int -> Int +signum x = + case ordInt x 0 of + LT -> -1 + EQ -> 0 + GT -> 1 + +even :: Int -> Bool +even n = n `rem` 2 == 0 + +odd :: Int -> Bool +odd n = not (even n) + +subtract :: Int -> Int -> Int +subtract a b = b - a + +gcd :: Int -> Int -> Int +gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined" +gcd x y = gcd' (abs x) (abs y) + where gcd' :: Int -> Int -> Int + gcd' x' 0 = x' + gcd' x' y' = gcd' y' (x' `rem` y') + +lcm :: Int -> Int -> Int +lcm _ 0 = 0 +lcm 0 _ = 0 +lcm x y = abs ((x `quot` gcd x y) * y) + +(^) :: Int -> Int -> Int +_ ^ 0 = 1 +i ^ n | n > 0 = f i (n-1) i + | otherwise = error "Prelude.^: negative exponent" + where f :: Int -> Int -> Int -> Int + f _ 0 y = y + f x m y = g x m + where g :: Int -> Int -> Int + g x' m' | even m' = g (x' * x') (m' `quot` 2) + | otherwise = f x' (m' - 1) (x' * y) + +{----------------------------------------------- + -- Float + -----------------------------------------------} + +{- imported from PreludePrim + +(+.) :: Float -> Float -> Float +(-.) :: Float -> Float -> Float +(*.) :: Float -> Float -> Float +(/.) :: Float -> Float -> Float + +(<.) :: Float -> Float -> Bool +(<=.) :: Float -> Float -> Bool +(>.) :: Float -> Float -> Bool +(>=.) :: Float -> Float -> Bool +(==.) :: Float -> Float -> Bool +(/=.) :: Float -> Float -> Bool + +sqrt :: Float -> Float +(**.) :: Float -> Float -> Float +exp :: Float -> Float +log :: Float -> Float +sin :: Float -> Float +cos :: Float -> Float +tan :: Float -> Float +-} + +signumFloat :: Float -> Int +signumFloat x = + case ordFloat x 0.0 of + LT -> -1 + EQ -> 0 + GT -> 1 + +(^.) :: Float -> Int -> Float +_ ^. 0 = 1.0 +i ^. n | n > 0 = f i (n-1) i + | otherwise = error "Prelude.^.: negative exponent" + where f :: Float -> Int -> Float -> Float + f _ 0 y = y + f x m y = g x m + where g :: Float -> Int -> Float + g x' m' | even m' = g (x' *. x') (m' `quot` 2) + | otherwise = f x' (m' - 1) (x' *. y) + +pi :: Float +pi = 3.141592653589793 + +{----------------------------------------------- + -- Bool + -----------------------------------------------} + +not :: Bool -> Bool +not False = True +not _ = False + +(||) :: Bool -> Bool -> Bool +(&&) :: Bool -> Bool -> Bool + +x || y = if x then x else y +x && y = if x then y else x + +otherwise :: Bool +otherwise = True + +{----------------------------------------------- + -- Maybe + -----------------------------------------------} + +data Maybe a + = Nothing + | Just a + +maybe :: b -> (a -> b) -> Maybe a -> b +maybe e f m = + case m of + Nothing -> e + Just x -> f x + +{----------------------------------------------- + -- Either + -----------------------------------------------} + +data Either a b = Left a | Right b + +either :: (a -> c) -> (b -> c) -> Either a b -> c +either l r e = + case e of + Left x -> l x + Right y -> r y + +{----------------------------------------------- + -- Ordering + -----------------------------------------------} + +data Ordering = LT | EQ | GT + +{----------------------------------------------- + -- Tuple + -----------------------------------------------} + +fst :: (a, b) -> a +fst (x, _) = x + +snd :: (a, b) -> b +snd (_, x) = x + +curry :: ((a,b) -> c) -> (a -> b -> c) +curry f x y = f (x,y) + +uncurry :: (a -> b -> c) -> ((a,b) -> c) +uncurry f p = f (fst p) (snd p) + +zip :: [a] -> [b] -> [(a,b)] +zip = zipWith (\a b -> (a,b)) + +zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] +zip3 = zipWith3 (\a b c -> (a,b,c)) + +zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] +zipWith z (a:as) (b:bs) = z a b : zipWith z as bs +zipWith _ _ _ = [] + +zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] +zipWith3 z (a:as) (b:bs) (c:cs) + = z a b c : zipWith3 z as bs cs +zipWith3 _ _ _ _ = [] + +unzip :: [(a,b)] -> ([a],[b]) +unzip = foldr (\(a,b) (as,bs) -> (a:as, b:bs)) ([], []) + +unzip3:: [(a,b,c)] -> ([a],[b],[c]) +unzip3 = foldr (\(a,b,c) (as,bs,cs) -> (a:as,b:bs,c:cs)) ([],[],[]) + +{----------------------------------------------- + -- List + -----------------------------------------------} + + -- We can't import Char here because that would mean we couldn't import +-- it elsewhere. Therefore, we make local copies of the two functions +-- from that module +localIsSpace :: Char -> Bool +localIsSpace c = + i == ord ' ' || i == ord '\t' || i == ord '\n' || + i == ord '\r' || i == ord '\f' || i == ord '\v' + where + i = ord c + +localIsDigit :: Char -> Bool +localIsDigit c = ord c >= ord '0' && ord c <= ord '9' + + +head :: [a] -> a +head (x:_) = x +head _ = error "Prelude.head: empty list" + +last :: [a] -> a +last [x] = x +last (_:xs) = last xs +last _ = error "Prelude.last: empty list" + +tail :: [a] -> [a] +tail (_:xs) = xs +tail _ = error "Prelude.tail: empty list" + +init :: [a] -> [a] +init [_] = [] +init (x:xs) = x : init xs +init _ = error "Prelude.init: empty list" + +null :: [a] -> Bool +null [] = True +null _ = False + +(++) :: [a] -> [a] -> [a] +(x:xs) ++ ys = x : (xs ++ ys) +[] ++ ys = ys + +map :: (a -> b) -> [a] -> [b] +map _ [] = [] +map f (x:xs) = f x : map f xs + +filter :: (a -> Bool) -> [a] -> [a] +filter p (x:xs) + | p x = x : filter p xs + | otherwise = filter p xs +filter _ [] = [] + +{- +Naive implementation of length (slow because of laziness) + +length :: [a] -> Int +length [] = 0 +length (_:xs) = 1 + length xs + +Optimised implementation using strict foldl: +-} + +length :: [a] -> Int +length xs = foldl' (\l _ -> l + 1) 0 xs + +concat :: [[a]] -> [a] +concat = foldr (++) [] + +(!!) :: [a] -> Int -> a +xs !! n | n < 0 = error "Prelude.(!!): negative index" + | null xs = error "Prelude.(!!): index too large" + | n == 0 = head xs + | otherwise = tail xs !! (n - 1) + +foldl :: (a -> b -> a) -> a -> [b] -> a +foldl _ z [] = z +foldl f z (x:xs) = foldl f (f z x) xs + +foldl' :: (a -> b -> a) -> a -> [b] -> a +foldl' _ a [] = a +foldl' f a (x:xs) = (foldl' f $! f a x) xs + +foldl1 :: (a -> a -> a) -> [a] -> a +foldl1 f (x:xs) = foldl f x xs +foldl1 _ [] = error "Prelude.foldl1: empty list" + +scanl :: (a -> b -> a) -> a -> [b] -> [a] +scanl f q xxs = + q + : + (case xxs of + x:xs -> scanl f (f q x) xs + [] -> [] + ) + +scanl1 :: (a -> a -> a) -> [a] -> [a] +scanl1 _ [] = [] +scanl1 f (x:xs) = scanl f x xs + +foldr :: (a -> b -> b) -> b -> [a] -> b +foldr _ z [] = z +foldr f z (x:xs) = x `f` (foldr f z xs) + +foldr1 :: (a -> a -> a) -> [a] -> a +foldr1 _ [x] = x +foldr1 f (x:xs) = f x (foldr1 f xs) +foldr1 _ [] = error "Prelude.foldr1: empty list" + +scanr :: (a -> b -> b) -> b -> [a] -> [b] +scanr _ q0 [] = [q0] +scanr f q0 (x:xs) = + case scanr f q0 xs of + qs@(q:_) -> f x q : qs + _ -> error "Prelude.scanr" + +scanr1 :: (a -> a -> a) -> [a] -> [a] +scanr1 _ [] = [] +scanr1 _ [x] = [x] +scanr1 f (x:xs) = + case scanr1 f xs of + qs@(q:_) -> f x q : qs + _ -> error "Prelude.scanr" + +iterate :: (a -> a) -> a -> [a] +iterate f x = x : iterate f (f x) + +repeat :: a -> [a] +repeat x = xs where xs = x:xs + +replicate :: Int -> a -> [a] +replicate n x = take n (repeat x) + +cycle :: [a] -> [a] +cycle [] = error "Prelude.cycle: empty list" +cycle xs = xs' where xs'=xs++xs' + +take :: Int -> [a] -> [a] +take n xs + | n <= 0 = [] + | otherwise = + case xs of + [] -> [] + (y:ys) -> y : take (n-1) ys + +drop :: Int -> [a] -> [a] +drop n xs + | n <= 0 = xs + | otherwise = + case xs of + [] -> [] + (_:ys) -> drop (n-1) ys + +splitAt :: Int -> [a] -> ([a], [a]) +splitAt n xs + | n <= 0 = ([],xs) + | otherwise = + case xs of + [] -> ([],[]) + (y:ys) -> (y:as,bs) where (as,bs) = splitAt (n-1) ys + +takeWhile :: (a -> Bool) -> [a] -> [a] +takeWhile _ [] = [] +takeWhile p (x:xs) + | p x = x : takeWhile p xs + | otherwise = [] + +dropWhile :: (a -> Bool) -> [a] -> [a] +dropWhile _ [] = [] +dropWhile p l@(x:xs) + | p x = dropWhile p xs + | otherwise = l + +span :: (a -> Bool) -> [a] -> ([a],[a]) +span _ [] = ([],[]) +span p xs@(x:xs') + | p x = (x:ys, zs) + | otherwise = ([],xs) + where (ys,zs) = span p xs' + +break :: (a -> Bool) -> [a] -> ([a],[a]) +break p = span (not . p) + +lines :: String -> [String] +lines "" = [] +lines s = let l,s' :: String + (l,s') = break (\x -> x `eqChar` '\n') s + in l : case s' of [] -> [] + (_:s'') -> lines s'' + +words :: String -> [String] +words s = + case dropWhile localIsSpace s of + "" -> [] + s' -> w : words s'' + where w,s'' :: String + (w,s'') = break localIsSpace s' + +unlines :: [String] -> String +unlines [] = [] +unlines (l:ls) = l ++ '\n' : unlines ls + +unwords :: [String] -> String +unwords [] = "" +unwords [w] = w +unwords (w:ws) = w ++ ' ' : unwords ws + +reverse :: [a] -> [a] +reverse = foldl (flip (:)) [] + +and :: [Bool] -> Bool +and = foldr (&&) True + +or :: [Bool] -> Bool +or = foldr (||) False + +any :: (a -> Bool) -> [a] -> Bool +any p = or . map p + +all :: (a -> Bool) -> [a] -> Bool +all p = and . map p + +sum :: [Int] -> Int +sum = foldl' (+) 0 + +sumFloat :: [Float] -> Float +sumFloat = foldl' (+.) 0.0 + +product :: [Int] -> Int +product = foldl' (*) 1 + +maximum :: [Int] -> Int +maximum = foldl1 max + +minimum :: [Int] -> Int +minimum = foldl1 min + +concatMap :: (a -> [b]) -> [a] -> [b] +concatMap f = concat . map f + +{----------------------------------------------- + -- Char + ----------------------------------------------- + +isSpace :: Char -> Bool +isSpace c = + let + i :: Int + i = ord c + in + i == ord ' ' || + i == ord '\t' || + i == ord '\n' || + i == ord '\r' || + i == ord '\f' || + i == ord '\v' + +isUpper :: Char -> Bool +isUpper c = ord c >= ord 'A' && ord c <= ord 'Z' + +isLower :: Char -> Bool +isLower c = ord c >= ord 'a' && ord c <= ord 'z' + +isDigit :: Char -> Bool +isDigit c = ord c >= ord '0' && ord c <= ord '9' + +isAlpha :: Char -> Bool +isAlpha c = isUpper c || isLower c + +isAlphaNum :: Char -> Bool +isAlphaNum c = isAlpha c || isDigit c + +toUpper :: Char -> Char +toUpper c + | isLower c = chr ( ord c - ord 'a' + ord 'A' ) + | otherwise = c + +toLower :: Char -> Char +toLower c + | isUpper c = chr ( ord c - ord 'A' + ord 'a' ) + | otherwise = c + -} + + +{----------------------------------------------- + -- Conversion + -----------------------------------------------} + +-- see also "read.." and "show.." below + +{- imported from PreludePrim + +ord :: Char -> Int +chr :: Int -> Char + +intToFloat :: Int -> Float +round :: Float -> Int +floor :: Float -> Int +ceiling :: Float -> Int +truncate :: Float -> Int + +-} + +fromInt :: Int -> Float +fromInt = intToFloat + +{----------------------------------------------- + -- Some standard functions + -----------------------------------------------} + +fix :: (a -> a) -> a +fix f = x where x = f x + +id :: a -> a +id x = x + +const :: a -> b -> a +const x _ = x + +(.) :: (b -> c) -> (a -> b) -> (a -> c) +(.) f g x = f (g x) + +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x + +($) :: (a -> b) -> a -> b +f $ x = f x + +{- imported from PreludePrim + +seq :: a -> b -> b +($!) :: (a -> b) -> a -> b +error :: String -> a + +-} + +until :: (a -> Bool) -> (a -> a) -> a -> a +until p f x = if p x then x else until p f (f x) + +undefined :: a +undefined = error "undefined" + +{----------------------------------------------- + -- IO + -----------------------------------------------} + +(>>=) :: IO a -> (a -> IO b) -> IO b +(>>=) io f = do x <- io + f x + +(>>) :: IO a -> IO b -> IO b +p >> q = p >>= \ _ -> q + +{- imported from PreludePrim +putChar :: Char -> IO () +putChar c = primPutChar c + +putStr :: String -> IO () +putStr s = primPutStr s + +putStrLn :: String -> IO () +putStrLn s = primPutStrLn s + +unsafePerformIO :: IO a -> a +unsafePerformIO = primUnsafePerformIO + +return :: a -> IO a +-} + +sequence :: [IO a] -> IO [a] +sequence [] = return [] +sequence (c:cs) = do { x <- c; xs <- sequence cs; return (x:xs) } + +sequence_ :: [IO a] -> IO () +sequence_ = foldr (>>) (return ()) + +print :: (a -> String) -> a -> IO () +print showElement e = putStrLn (showElement e) + +getLine :: IO String +getLine = do + c <- getChar + if eqChar c '\n' + then return "" + else do cs <- getLine + return (c:cs) + +writeFile :: String -> String -> IO () +writeFile fname s + = bracketIO (openFile fname WriteMode) + (hClose) + (\h -> hPutString h s) + +readFile :: String -> IO String +readFile fname + = bracketIO (openFile fname ReadMode) + (hClose) + (\h -> readAll h []) + where + readAll h acc + = do c <- hGetChar h + readAll h (c:acc) + `catchEof` (return (reverse acc)) + +bracketIO :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c +bracketIO acquire release action + = do x <- acquire + finallyIO (action x) (release x) + +finallyIO :: IO a -> IO b -> IO a +finallyIO io action + = do x <- io `catch` (\exn -> do{ action; raise exn }) + action + return x + +{----------------------------------------------- + -- HELIUM SPECIFIC + -----------------------------------------------} + +{----------------------------------------------- + -- Eq + -----------------------------------------------} + +eqChar :: Char -> Char -> Bool +eqChar c1 c2 = + case ordChar c1 c2 of + EQ -> True + _ -> False + +eqMaybe :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool +eqMaybe _ Nothing Nothing = True +eqMaybe eq (Just a1) (Just a2) = a1 `eq` a2 +eqMaybe _ _ _ = False + +eqBool :: Bool -> Bool -> Bool +eqBool True True = True +eqBool False False = True +eqBool _ _ = False + +eqList :: (a -> a -> Bool) -> [a] -> [a] -> Bool +eqList _ [] [] = True +eqList eqElem (x:xs) (y:ys) = x `eqElem` y && eqList eqElem xs ys +eqList _ _ _ = False + +eqTuple2 :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool +eqTuple2 eqA eqB (a1, b1) (a2, b2) = a1 `eqA` a2 && b1 `eqB` b2 + +eqString :: String -> String -> Bool +eqString s1 s2 = + case ordString s1 s2 of + EQ -> True + _ -> False + +eqInt :: Int -> Int -> Bool +eqInt = (==) + +eqFloat :: Float -> Float -> Bool +eqFloat = (==.) + +{----------------------------------------------- + -- Ord + -----------------------------------------------} + +ordString :: String -> String -> Ordering +ordString = ordList ordChar + +ordChar :: Char -> Char -> Ordering +ordChar c1 c2 = ordInt (ord c1) (ord c2) + +ordInt :: Int -> Int -> Ordering +ordInt x y + | x < y = LT + | x == y = EQ + | otherwise = GT + +ordFloat :: Float -> Float -> Ordering +ordFloat x y + | x <. y = LT + | x ==. y = EQ + | otherwise = GT + +ordList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering +ordList _ [] (_:_) = LT +ordList _ [] [] = EQ +ordList _ (_:_) [] = GT +ordList ordElem (x:xs) (y:ys) = + case ordElem x y of + GT -> GT + LT -> LT + EQ -> ordList ordElem xs ys + +{----------------------------------------------- + -- Show + -----------------------------------------------} + +{- Imported from HeliumLang: + showFunction, showIO, showPolymorphic + showChar, showString, showInt, showList, showBool, showUnit, showFloat + showTuple2, showTuple3, showTuple4, showTuple5, showTuple6, showTuple7 + showTuple8, showTuple9, showTuple10 +-} + +{----------------------------------------------- + -- Read + -----------------------------------------------} + +readInt :: String -> Int +readInt [] = 0 +readInt ('-':s) = - readUnsigned s +readInt s = readUnsigned s + +readUnsigned :: String -> Int +readUnsigned = + foldl (\a b -> a * 10 + b) 0 + . + map (\c -> ord c - ord '0') + . + takeWhile localIsDigit + +{----------------------------------------------- + -- "Overloaded" functions + -----------------------------------------------} + +elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool +elemBy _ _ [] = False +elemBy eq x (y:ys) + | x `eq` y = True + | otherwise = elemBy eq x ys + +notElemBy :: (a -> a -> Bool) -> a -> [a] -> Bool +notElemBy eq x ys = not (elemBy eq x ys) + +lookupBy :: (a -> a -> Bool) -> a -> [(a,b)] -> Maybe b +lookupBy _ _ [] = Nothing +lookupBy eq k ((x,y):xys) + | k `eq` x = Just y + | otherwise = lookupBy eq k xys + diff --git a/lib/simple/Prelude.type b/lib/simple/Prelude.type new file mode 100644 --- /dev/null +++ b/lib/simple/Prelude.type @@ -0,0 +1,57 @@ +-------------------------------------------------------- +-- Type inference directives: Sibling functions + +-- int versus float arithmetic +siblings + , +. ; +siblings * , *. ; +siblings - , -. ; +siblings ^ , ^. ; +siblings div , /. ; +siblings / , /. ; + +-- int versus float comparison functions +siblings >== , >=. ; +siblings <= , <=. ; +siblings == , ==. ; +siblings /= , /=. ; +siblings < , <. ; +siblings > , >. ; + +-- binary and n-ary operations +siblings max , maximum ; +siblings min , minimum ; +siblings sum , + ; +siblings product , * ; + +-- maybe constructors +siblings Just , Nothing ; + +-- either constructors +siblings Left , Right ; + +-- tuple functions +siblings fst , snd ; +siblings curry , uncurry ; +siblings zip , zip3 , unzip , unzip3 ; + +-- list functions +siblings : , ++ ; +siblings foldl , foldl1 , scanl , scanl1 ; +siblings foldr , foldr1 , scanr , scanr1 ; +siblings words , unwords ; +siblings lines , unlines ; +siblings map , concatMap ; + +-- Helium specific functions +siblings == , eqChar, eqMaybe, eqBool, eqList, eqTuple2, eqString ; +siblings ordString, ordChar, ordInt, ordList ; +siblings showBool , showChar , showFloat , showInt ; +siblings showString , showList , showMaybe , showEither , showOrdering , + howUnit , showTuple2 , showTuple3 , showTuple4 , showTuple5 , + showTuple6 , showTuple7 , showTuple8, showTuple9, showTuple10 ; + +-- Java string concat +siblings + , ++ ; + +-- Char, Int conversions +siblings ord , chr ; diff --git a/lib/simple/PreludePrim.core b/lib/simple/PreludePrim.core new file mode 100644 --- /dev/null +++ b/lib/simple/PreludePrim.core @@ -0,0 +1,295 @@ +module PreludePrim + ( + -- Conversion + ord, chr, intToFloat, ceiling, floor, truncate, round + + -- Int + , (+), (-), (*), div, mod, quot, rem, negate + , (==), (/=), (<), (>), (<=), (>=) + + -- Float + , (+.), (-.), (*.), (/.) + , (==.), (/=.), (<.), (>.), (<=.), (>=.) + , sqrt, (**.), exp, log, sin, cos, tan + + + -- Enum + , enumFrom, enumFromThen, enumFromTo, enumFromThenTo + + -- IO monad + , return + , unsafePerformIO + , putChar, putStr, putStrLn + + -- IO files + , getChar + , Handle, stdin, stdout, stderr + , IOMode(..), openFile, hClose + , hGetChar, hPutChar, hPutString + + -- strictness + , ($!), seq + + -- misc + , error, catch, catchEof, raise + ) where + +import LvmLang + ( return = returnIO, bindIO + + , (+), (-), (*), div = (/), mod = (%), quot, rem, negInt + , (==), (/=), (<), (>), (<=), (>=) + + , (+.), (-.), (*.), (/.) + , (==.), (/=.), (<.), (>.), (<=.), (>=.) + + , ($!), seq + , True -- hack + ) +import LvmIO + ( stdinChannel = stdin, stdoutChannel = stdout, stderrChannel = stderr + , Channel(), Input(), Output() + , CreateMode(CreateIfNotExists, CreateOverwrite) + , openInputFile, openOutputFile + , close, flush + , inputChar, outputChar, outputString + ) +import LvmException + ( error, errorPacked {- hack -}, catch, raise + , Exception(System), SystemException(EndOfFile) + ) + +import HeliumLang + ( ''$negate'' + , ''$enumFrom'', ''$enumFromThen'', ''$enumFromTo'', ''$enumFromThenTo'' + , ''$primPutChar'', ''$primPutStr'', ''$primPutStrLn'', ''$primUnsafePerformIO'' + ) + +custom infix (+) : public [6,"left"] +custom infix (-) : public [6,"left"] +custom infix (*) : public [7,"left"] +custom infix div : public [7,"left"] +custom infix mod : public [7,"left"] +custom infix quot : public [7,"left"] +custom infix rem : public [7,"left"] + +custom infix (==) : public [4,"none"] +custom infix (/=) : public [4,"none"] +custom infix (<) : public [4,"none"] +custom infix (>) : public [4,"none"] +custom infix (<=) : public [4,"none"] +custom infix (>=) : public [4,"none"] + +custom infix (+.) : public [6,"left"] +custom infix (-.) : public [6,"left"] +custom infix (*.) : public [7,"left"] +custom infix (/.) : public [7,"left"] + +custom infix (==.) : public [4,"none"] +custom infix (/=.) : public [4,"none"] +custom infix (<.) : public [4,"none"] +custom infix (>.) : public [4,"none"] +custom infix (<=.) : public [4,"none"] +custom infix (>=.) : public [4,"none"] + +custom infix (**.) : public [8,"right"] +custom infix ($!) : public [0,"right"] + +ord :: Char -> Int +ord x = x + +chr :: Int -> Char +chr x = x + +{-------------------------------------------------------------------------- + IO +--------------------------------------------------------------------------} +putChar :: Char -> IO () +putChar c = ''$primPutChar''c + +putStr :: String -> IO () +putStr s = ''$primPutStr'' s + +putStrLn :: String -> IO () +putStrLn s = ''$primPutStrLn'' s + +unsafePerformIO :: IO a -> a +unsafePerformIO io + = ''$primUnsafePerformIO'' io + + +-- Float + +extern primFloatSqrt "fp_sqrt" :: "FF" +extern float_of_string_extern "float_of_string" :: "Fz" + +sqrt :: Float -> Float +sqrt x = let! x = x + y = float_of_string_extern "0.0" + in + case (>=.) x y of + { True -> primFloatSqrt x + ; _ -> errorPacked "Can't apply sqrt to negative floating-point number" + } + +extern primFloatPower "fp_pow" :: "FFF" + +(**.) :: Float -> Float -> Float +(**.) x y = let! x = x in let! y = y in primFloatPower x y + +extern primFloatExp "fp_exp" :: "FF" + +exp :: Float -> Float +exp x = let! x = x in primFloatExp x + +extern primFloatLog "fp_log" :: "FF" + +log :: Float -> Float +log x = let! x = x in primFloatLog x + +extern primFloatSin "fp_sin" :: "FF" + +sin :: Float -> Float +sin x = let! x = x in primFloatSin x + +extern primFloatCos "fp_cos" :: "FF" + +cos :: Float -> Float +cos x = let! x = x in primFloatCos x + +extern primFloatTan "fp_tan" :: "FF" + +tan :: Float -> Float +tan x = let! x = x in primFloatTan x + +extern primIntToFloat "float_of_int" :: "FI" + +intToFloat :: Int -> Float +intToFloat x = let! x = x in primIntToFloat x + +extern primFloatCeil "fp_ceil" :: "FF" + +ceiling :: Float -> Int +ceiling x = let! x = x + y = primFloatCeil x + in primFloatTruncateInt y + +extern primFloatFloor "fp_floor" :: "FF" + +floor :: Float -> Int +floor x = let! x = x + y = primFloatFloor x + in primFloatTruncateInt y + +extern primFloatTruncateInt "fp_trunc_int" :: "IF" + +truncate :: Float -> Int +truncate x = let! x = x in primFloatTruncateInt x + +extern primFloatNear "fp_near" :: "FF" +extern primFloatRoundInt "fp_round_int" :: "IF" + +round :: Float -> Int +round x + = let! y = x + z = primFloatNear y + i = primFloatRoundInt z + in i + +{-------------------------------------------------------------------------- + Re-export Builtins +--------------------------------------------------------------------------} +negate :: Int -> Int +negate x = ''$negate'' x + +enumFrom :: Int -> [Int] +enumFrom n = ''$enumFrom'' n + +enumFromTo :: Int -> Int -> [Int] +enumFromTo n m = ''$enumFromTo'' n m + +enumFromThen :: Int -> Int -> [Int] +enumFromThen n a = ''$enumFromThen'' n a + +enumFromThenTo :: Int -> Int -> Int -> [Int] +enumFromThenTo n a m = + ''$enumFromThenTo'' n a m + +{-------------------------------------------------------------------------- + IO +--------------------------------------------------------------------------} +data Handle + = HandleRead (Channel Input) + | HandleWrite (Channel Output) + +data IOMode + = ReadMode + | WriteMode + | AppendMode + +stdin :: Handle +stdin + = HandleRead stdinChannel + +stdout :: Handle +stdout + = HandleWrite stdoutChannel + +stderr :: Handle +stderr + = HandleWrite stderrChannel + +getChar :: IO Char +getChar + = inputChar stdinChannel -- hGetChar stdin + +openFile :: String -> IOMode -> IO Handle +openFile fpath mode + = case mode of + ReadMode -> bindIO (openInputFile fpath True) (\ch -> return (HandleRead ch)) + WriteMode -> bindIO (openOutputFile fpath True CreateOverwrite) (\ch -> return (HandleWrite ch)) + AppendMode-> bindIO (openOutputFile fpath True CreateIfNotExists) (\ch -> return (HandleWrite ch)) + +hClose :: Handle -> IO () +hClose handle + = case handle of + HandleRead ch -> close ch + HandleWrite ch -> -- FUUCCKK: alleen maar om altijd geflushed te closen.. + catch (bindIO (flush ch) (\_ -> close ch)) + (\exn -> bindIO (catch (close ch) (\_ -> raise exn)) + (\_ -> raise exn)) + +hFlush :: Handle -> IO () +hFlush handle + = case handle of + HandleRead ch -> flush ch + HandleWrite ch -> flush ch + +hGetChar :: Handle -> IO Char +hGetChar handle + = case handle of + HandleRead ch -> inputChar ch + HandleWrite ch -> errorPacked "PreludePrim.hGetChar: Handle is not open for reading" + +hPutChar :: Handle -> Char -> IO () +hPutChar handle c + = case handle of + HandleRead ch -> errorPacked "PreludePrim.hPutChar: Handle is not open for writing" + HandleWrite ch -> outputChar ch c + +hPutString :: Handle -> String -> IO () +hPutString handle s + = case handle of + HandleRead ch -> errorPacked "PreludePrim.hPutString: Handle is not open for writing" + HandleWrite ch -> outputString ch s + +catchEof :: IO a -> IO a -> IO a +catchEof io onEof + = catch io + (\exn -> case exn of + System sysexn -> case sysexn of + EndOfFile -> onEof + _ -> raise exn + _ -> raise exn + ) + diff --git a/src/Helium/CodeGeneration/CodeGeneration.ag b/src/Helium/CodeGeneration/CodeGeneration.ag new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/CodeGeneration.ag @@ -0,0 +1,77 @@ +ATTR Module + [ dictionaryEnv : DictionaryEnvironment + extraDecls : { [Core.CoreDecl] } + importEnv : ImportEnvironment + toplevelTypes : TypeEnvironment + | + | core : { Core.CoreModule } + ] + +-- UHA +INCLUDE "UHA_Syntax.ag" + +-- Transformation into Core +INCLUDE "ToCoreModule.ag" +INCLUDE "ToCoreDecl.ag" +INCLUDE "ToCoreExpr.ag" +INCLUDE "ToCorePat.ag" +INCLUDE "ToCoreName.ag" + +imports{ +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils +import Helium.Syntax.UHA_Range +import Helium.ModuleSystem.ImportEnvironment +import Helium.ModuleSystem.DictionaryEnvironment +import qualified Data.Map as M +import Helium.StaticAnalysis.Miscellaneous.TypeConversion +import Data.Char (ord) + + +import Lvm.Common.Id +import Lvm.Common.IdSet +import Helium.Utils.Utils(internalError) + +import Top.Types + +import Helium.CodeGeneration.PatternMatch +import qualified Helium.CodeGeneration.DerivingShow as DerivingShow +import qualified Helium.CodeGeneration.DerivingEq as DerivingEq + +-- Semi-Daan +import Helium.CodeGeneration.CoreUtils + +-- Daan +import qualified Lvm.Core.Expr as Core +import qualified Lvm.Core.Module as Core +import qualified Lvm.Core.Module as Module +import qualified Lvm.Common.Byte as Byte +} + +{ + +type CoreDecl = Core.Decl Core.Expr +} + +--Collect.ag + +ATTR Body Declarations Declaration Expressions Expression Statements Statement + Qualifiers Qualifier GuardedExpressions GuardedExpression + Alternatives Alternative FunctionBindings FunctionBinding + RightHandSide MaybeDeclarations MaybeExpression RecordExpressionBinding + RecordExpressionBindings Constructors Constructor + [ dictionaryEnv : DictionaryEnvironment | | ] + +ATTR Body Declarations Declaration Constructor Constructors + [ importEnv : ImportEnvironment | | ] + +SEM Expression | Let loc.importEnv = internalError "CodeGeneration.ag" "Expression.Let" "" +SEM MaybeDeclarations | Just loc.importEnv = internalError "CodeGeneration.ag" "MaybeDeclarations.Just" "" +SEM Qualifier | Let loc.importEnv = internalError "CodeGeneration.ag" "Qualifier.Let" "" +SEM Statement | Let loc.importEnv = internalError "CodeGeneration.ag" "Statement.Let" "" + +ATTR SimpleType [ | | name:Name typevariables:Names ] + +SEM SimpleType + | SimpleType lhs . name = @name.self + . typevariables = @typevariables.self diff --git a/src/Helium/CodeGeneration/CodeGeneration.hs b/src/Helium/CodeGeneration/CodeGeneration.hs new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/CodeGeneration.hs @@ -0,0 +1,7466 @@ +{-# LANGUAGE Rank2Types, GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Helium.CodeGeneration.CodeGeneration where + +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils +import Helium.Syntax.UHA_Range +import Helium.ModuleSystem.ImportEnvironment +import Helium.ModuleSystem.DictionaryEnvironment +import qualified Data.Map as M +import Helium.StaticAnalysis.Miscellaneous.TypeConversion +import Data.Char (ord) + + +import Lvm.Common.Id +import Lvm.Common.IdSet +import Helium.Utils.Utils(internalError) + +import Top.Types + +import Helium.CodeGeneration.PatternMatch +import qualified Helium.CodeGeneration.DerivingShow as DerivingShow +import qualified Helium.CodeGeneration.DerivingEq as DerivingEq + +-- Semi-Daan +import Helium.CodeGeneration.CoreUtils + +-- Daan +import qualified Lvm.Core.Expr as Core +import qualified Lvm.Core.Module as Core +import qualified Lvm.Core.Module as Module +import qualified Lvm.Common.Byte as Byte + + +import Lvm.Common.Byte(bytesFromString) +import Control.Monad.Identity (Identity) +import qualified Control.Monad.Identity + + +type CoreDecl = Core.Decl Core.Expr + + +makeCoreModule :: Maybe Id -> [Module.Decl v] -> Module.Module v +makeCoreModule name decls = + Module.Module + { Module.moduleName = + case name of + Nothing -> idFromString "Main" + Just n -> n + , Module.moduleMajorVer = 0 + , Module.moduleMinorVer = 0 + , Module.moduleDecls = decls + } + +interpreterMain :: String +interpreterMain = "interpreter_main" + +-- Unfortunately we need a hack for the interpreter +-- The interpreter_main has te be wrapped inside unsafePerformIO etcetera, too +-- We can't just call it main because we'll get import clashes. Sigh! + +insertedMain :: TypeEnvironment -> CoreDecl +insertedMain toplevelTypes = + let maybeWrapMainAndType = + case M.lookup (Name_Identifier noRange [] "main") toplevelTypes of -- !!!Name + Just t -> Just ("main", t) + Nothing -> + case M.lookup (Name_Identifier noRange [] interpreterMain) toplevelTypes of -- !!!Name + Just t -> Just (interpreterMain, t) + Nothing -> Nothing + in + decl False "main$" $ + app_ unsafePIO $ + case maybeWrapMainAndType of + Nothing -> + var "$primPutStrLn" `app_` + (var "$primPackedToString" `app_` + packedString "No 'main' function defined in this module") + Just (name, tpScheme) + | not (null qs) -> + var "$primPutStrLn" `app_` + (var "$primPackedToString" `app_` + packedString "<>") + | isIOType tp -> + var name + | otherwise -> + var "$primPutStrLn" `app_` + (DerivingShow.showFunctionOfType True (makeTypeFromTp tp) `app_` + var name) + where + (qs, tp) = split (snd (instantiate 123456789 tpScheme)) + where + unsafePIO = var "$primUnsafePerformIO" + + + +-- set the public bit of all declarations except those that are imported from +-- Prelude or HeliumLang. I.e. export everything everywhere +everythingPublicButPrelude :: Core.CoreModule -> Core.CoreModule +everythingPublicButPrelude theModule = theModule { Core.moduleDecls = map setPublic (Core.moduleDecls theModule) } + where + setPublic declaration = + let -- accessRecord = Core.declAccess decl + public = case Core.declAccess declaration of + Core.Defined _ -> True + Core.Imported { Core.importModule = m } -> + stringFromId m `notElem` ["Prelude", "HeliumLang"] + in + declaration{ Core.declAccess = + (Core.declAccess declaration){ Core.accessPublic = public } } + + +predicateToId :: Predicate -> Id +predicateToId (Predicate class_ tp) = + idFromString $ "$dict" ++ class_ ++ show tp + +dictionaryTreeToCore :: DictionaryTree -> Core.Expr +dictionaryTreeToCore theTree = + case theTree of + ByPredicate predicate -> + Core.Var (predicateToId predicate) + ByInstance className instanceName trees -> + foldl Core.Ap + (Core.Var (idFromString ("$dict"++className++instanceName))) + (map dictionaryTreeToCore trees) + BySuperClass subClass superClass tree -> + Core.Ap (Core.Var (idFromString ("$get" ++ superClass ++ "From" ++ subClass))) + (dictionaryTreeToCore tree) + +insertDictionaries :: Name -> DictionaryEnvironment -> Core.Expr +insertDictionaries name dictionaryEnv = + foldl Core.Ap + (Core.Var (idFromName name)) + (map dictionaryTreeToCore (getDictionaryTrees name dictionaryEnv)) + + +toplevelType :: Name -> ImportEnvironment -> Bool -> [Core.Custom] +toplevelType name ie isTopLevel + | isTopLevel = [custom "type" typeString] + | otherwise = [] + where + typeString = maybe + (internalError "ToCoreDecl" "Declaration" ("no type found for " ++ getNameName name)) + show + (M.lookup name (typeEnvironment ie)) + +constructorCustoms :: Name -> Name -> ValueConstructorEnvironment -> [Core.Custom] +constructorCustoms dataTypeName name env = + maybe + (internalError "ToCoreDecl" "Constructor" ("no type found for " ++ show name)) + (\tpScheme -> + [ custom "type" (show tpScheme) + , Core.CustomLink + (idFromName dataTypeName) + (Core.DeclKindCustom (idFromString "data")) + ] + ) + (M.lookup name env) + + + +-- Function "bind" is used in the translation of do-expressions +bind :: Core.Expr -> Core.Expr -> Core.Expr +bind ma f = Core.Var primBindIOId `app_` ma `app_` f + +primBindIOId, caseExprId, okId, parameterId :: Id +( primBindIOId : caseExprId : okId : parameterId : []) = map idFromString $ + "$primBindIO" : "caseExpr$" : "ok$" : "parameter$" : [] + +-- Function "chainCode" is used in the translation of do-expressions +chainCode :: [Maybe Core.Expr -> Core.Expr] -> Core.Expr +chainCode theCores = + case theCores of + [core] -> core Nothing + (core:cores) -> core (Just (chainCode cores)) + [] -> error "pattern match failure in CodeGeneration.ToCoreExpr.chainCode" + + + +patternAlwaysSucceeds :: Pattern -> Bool +patternAlwaysSucceeds p = + case p of + Pattern_Variable _ _ -> True + Pattern_Wildcard _ -> True + Pattern_As _ _ pat -> patternAlwaysSucceeds pat + Pattern_Parenthesized _ pat -> patternAlwaysSucceeds pat + _ -> False + +patternMatchFail :: String -> Range -> Core.Expr +patternMatchFail nodeDescription range = + var "$primPatternFailPacked" + `app_` packedString ( + nodeDescription ++ " ranging from " ++ + showPosition start ++ " to " ++ + showPosition (getRangeEnd range) ++ " in module " ++ + moduleFromPosition start + ) + where + start = getRangeStart range +-- Alternative ------------------------------------------------- +-- wrapper +data Inh_Alternative = Inh_Alternative { dictionaryEnv_Inh_Alternative :: (DictionaryEnvironment) } +data Syn_Alternative = Syn_Alternative { core_Syn_Alternative :: ( Core.Expr -> Core.Expr ), self_Syn_Alternative :: (Alternative) } +{-# INLINABLE wrap_Alternative #-} +wrap_Alternative :: T_Alternative -> Inh_Alternative -> (Syn_Alternative ) +wrap_Alternative (T_Alternative act) (Inh_Alternative _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternative_vIn1 _lhsIdictionaryEnv + (T_Alternative_vOut1 _lhsOcore _lhsOself) <- return (inv_Alternative_s2 sem arg) + return (Syn_Alternative _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternative #-} +sem_Alternative :: Alternative -> T_Alternative +sem_Alternative ( Alternative_Hole range_ id_ ) = sem_Alternative_Hole ( sem_Range range_ ) id_ +sem_Alternative ( Alternative_Feedback range_ feedback_ alternative_ ) = sem_Alternative_Feedback ( sem_Range range_ ) feedback_ ( sem_Alternative alternative_ ) +sem_Alternative ( Alternative_Alternative range_ pattern_ righthandside_ ) = sem_Alternative_Alternative ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Alternative ( Alternative_Empty range_ ) = sem_Alternative_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Alternative = T_Alternative { + attach_T_Alternative :: Identity (T_Alternative_s2 ) + } +newtype T_Alternative_s2 = C_Alternative_s2 { + inv_Alternative_s2 :: (T_Alternative_v1 ) + } +data T_Alternative_s3 = C_Alternative_s3 +type T_Alternative_v1 = (T_Alternative_vIn1 ) -> (T_Alternative_vOut1 ) +data T_Alternative_vIn1 = T_Alternative_vIn1 (DictionaryEnvironment) +data T_Alternative_vOut1 = T_Alternative_vOut1 ( Core.Expr -> Core.Expr ) (Alternative) +{-# NOINLINE sem_Alternative_Hole #-} +sem_Alternative_Hole :: T_Range -> (Integer) -> T_Alternative +sem_Alternative_Hole arg_range_ arg_id_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule0 () + _self = rule1 _rangeIself arg_id_ + _lhsOself :: Alternative + _lhsOself = rule2 _self + __result_ = T_Alternative_vOut1 _lhsOcore _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule0 #-} + rule0 = \ (_ :: ()) -> + id + {-# INLINE rule1 #-} + rule1 = \ ((_rangeIself) :: Range) id_ -> + Alternative_Hole _rangeIself id_ + {-# INLINE rule2 #-} + rule2 = \ _self -> + _self +{-# NOINLINE sem_Alternative_Feedback #-} +sem_Alternative_Feedback :: T_Range -> (String) -> T_Alternative -> T_Alternative +sem_Alternative_Feedback arg_range_ arg_feedback_ arg_alternative_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _alternativeX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_alternative_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Alternative_vOut1 _alternativeIcore _alternativeIself) = inv_Alternative_s2 _alternativeX2 (T_Alternative_vIn1 _alternativeOdictionaryEnv) + _self = rule3 _alternativeIself _rangeIself arg_feedback_ + _lhsOself :: Alternative + _lhsOself = rule4 _self + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule5 _alternativeIcore + _alternativeOdictionaryEnv = rule6 _lhsIdictionaryEnv + __result_ = T_Alternative_vOut1 _lhsOcore _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule3 #-} + rule3 = \ ((_alternativeIself) :: Alternative) ((_rangeIself) :: Range) feedback_ -> + Alternative_Feedback _rangeIself feedback_ _alternativeIself + {-# INLINE rule4 #-} + rule4 = \ _self -> + _self + {-# INLINE rule5 #-} + rule5 = \ ((_alternativeIcore) :: Core.Expr -> Core.Expr ) -> + _alternativeIcore + {-# INLINE rule6 #-} + rule6 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Alternative_Alternative #-} +sem_Alternative_Alternative :: T_Range -> T_Pattern -> T_RightHandSide -> T_Alternative +sem_Alternative_Alternative arg_range_ arg_pattern_ arg_righthandside_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself _patternIvars) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_RightHandSide_vOut148 _righthandsideIcore _righthandsideIisGuarded _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOdictionaryEnv) + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule7 _patternIself _righthandsideIcore + _self = rule8 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Alternative + _lhsOself = rule9 _self + _righthandsideOdictionaryEnv = rule10 _lhsIdictionaryEnv + __result_ = T_Alternative_vOut1 _lhsOcore _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule7 #-} + rule7 = \ ((_patternIself) :: Pattern) ((_righthandsideIcore) :: Core.Expr ) -> + \nextCase -> + let thisCase = + patternToCore + (caseExprId, _patternIself) + _righthandsideIcore + in + let_ nextClauseId nextCase thisCase + {-# INLINE rule8 #-} + rule8 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Alternative_Alternative _rangeIself _patternIself _righthandsideIself + {-# INLINE rule9 #-} + rule9 = \ _self -> + _self + {-# INLINE rule10 #-} + rule10 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Alternative_Empty #-} +sem_Alternative_Empty :: T_Range -> T_Alternative +sem_Alternative_Empty arg_range_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule11 () + _self = rule12 _rangeIself + _lhsOself :: Alternative + _lhsOself = rule13 _self + __result_ = T_Alternative_vOut1 _lhsOcore _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule11 #-} + rule11 = \ (_ :: ()) -> + id + {-# INLINE rule12 #-} + rule12 = \ ((_rangeIself) :: Range) -> + Alternative_Empty _rangeIself + {-# INLINE rule13 #-} + rule13 = \ _self -> + _self + +-- Alternatives ------------------------------------------------ +-- wrapper +data Inh_Alternatives = Inh_Alternatives { caseRange_Inh_Alternatives :: (Range), dictionaryEnv_Inh_Alternatives :: (DictionaryEnvironment) } +data Syn_Alternatives = Syn_Alternatives { core_Syn_Alternatives :: ( Core.Expr ), self_Syn_Alternatives :: (Alternatives) } +{-# INLINABLE wrap_Alternatives #-} +wrap_Alternatives :: T_Alternatives -> Inh_Alternatives -> (Syn_Alternatives ) +wrap_Alternatives (T_Alternatives act) (Inh_Alternatives _lhsIcaseRange _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternatives_vIn4 _lhsIcaseRange _lhsIdictionaryEnv + (T_Alternatives_vOut4 _lhsOcore _lhsOself) <- return (inv_Alternatives_s5 sem arg) + return (Syn_Alternatives _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternatives #-} +sem_Alternatives :: Alternatives -> T_Alternatives +sem_Alternatives list = Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) + +-- semantic domain +newtype T_Alternatives = T_Alternatives { + attach_T_Alternatives :: Identity (T_Alternatives_s5 ) + } +newtype T_Alternatives_s5 = C_Alternatives_s5 { + inv_Alternatives_s5 :: (T_Alternatives_v4 ) + } +data T_Alternatives_s6 = C_Alternatives_s6 +type T_Alternatives_v4 = (T_Alternatives_vIn4 ) -> (T_Alternatives_vOut4 ) +data T_Alternatives_vIn4 = T_Alternatives_vIn4 (Range) (DictionaryEnvironment) +data T_Alternatives_vOut4 = T_Alternatives_vOut4 ( Core.Expr ) (Alternatives) +{-# NOINLINE sem_Alternatives_Cons #-} +sem_Alternatives_Cons :: T_Alternative -> T_Alternatives -> T_Alternatives +sem_Alternatives_Cons arg_hd_ arg_tl_ = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 _lhsIcaseRange _lhsIdictionaryEnv) -> ( let + _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_hd_)) + _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_tl_)) + (T_Alternative_vOut1 _hdIcore _hdIself) = inv_Alternative_s2 _hdX2 (T_Alternative_vIn1 _hdOdictionaryEnv) + (T_Alternatives_vOut4 _tlIcore _tlIself) = inv_Alternatives_s5 _tlX5 (T_Alternatives_vIn4 _tlOcaseRange _tlOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule14 _hdIcore _tlIcore + _self = rule15 _hdIself _tlIself + _lhsOself :: Alternatives + _lhsOself = rule16 _self + _hdOdictionaryEnv = rule17 _lhsIdictionaryEnv + _tlOcaseRange = rule18 _lhsIcaseRange + _tlOdictionaryEnv = rule19 _lhsIdictionaryEnv + __result_ = T_Alternatives_vOut4 _lhsOcore _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule14 #-} + rule14 = \ ((_hdIcore) :: Core.Expr -> Core.Expr ) ((_tlIcore) :: Core.Expr ) -> + _hdIcore _tlIcore + {-# INLINE rule15 #-} + rule15 = \ ((_hdIself) :: Alternative) ((_tlIself) :: Alternatives) -> + (:) _hdIself _tlIself + {-# INLINE rule16 #-} + rule16 = \ _self -> + _self + {-# INLINE rule17 #-} + rule17 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule18 #-} + rule18 = \ ((_lhsIcaseRange) :: Range) -> + _lhsIcaseRange + {-# INLINE rule19 #-} + rule19 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Alternatives_Nil #-} +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 _lhsIcaseRange _lhsIdictionaryEnv) -> ( let + _lhsOcore :: Core.Expr + _lhsOcore = rule20 _lhsIcaseRange + _self = rule21 () + _lhsOself :: Alternatives + _lhsOself = rule22 _self + __result_ = T_Alternatives_vOut4 _lhsOcore _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule20 #-} + rule20 = \ ((_lhsIcaseRange) :: Range) -> + patternMatchFail "case expression" _lhsIcaseRange + {-# INLINE rule21 #-} + rule21 = \ (_ :: ()) -> + [] + {-# INLINE rule22 #-} + rule22 = \ _self -> + _self + +-- AnnotatedType ----------------------------------------------- +-- wrapper +data Inh_AnnotatedType = Inh_AnnotatedType { } +data Syn_AnnotatedType = Syn_AnnotatedType { self_Syn_AnnotatedType :: (AnnotatedType) } +{-# INLINABLE wrap_AnnotatedType #-} +wrap_AnnotatedType :: T_AnnotatedType -> Inh_AnnotatedType -> (Syn_AnnotatedType ) +wrap_AnnotatedType (T_AnnotatedType act) (Inh_AnnotatedType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedType_vIn7 + (T_AnnotatedType_vOut7 _lhsOself) <- return (inv_AnnotatedType_s8 sem arg) + return (Syn_AnnotatedType _lhsOself) + ) + +-- cata +{-# INLINE sem_AnnotatedType #-} +sem_AnnotatedType :: AnnotatedType -> T_AnnotatedType +sem_AnnotatedType ( AnnotatedType_AnnotatedType range_ strict_ type_ ) = sem_AnnotatedType_AnnotatedType ( sem_Range range_ ) strict_ ( sem_Type type_ ) + +-- semantic domain +newtype T_AnnotatedType = T_AnnotatedType { + attach_T_AnnotatedType :: Identity (T_AnnotatedType_s8 ) + } +newtype T_AnnotatedType_s8 = C_AnnotatedType_s8 { + inv_AnnotatedType_s8 :: (T_AnnotatedType_v7 ) + } +data T_AnnotatedType_s9 = C_AnnotatedType_s9 +type T_AnnotatedType_v7 = (T_AnnotatedType_vIn7 ) -> (T_AnnotatedType_vOut7 ) +data T_AnnotatedType_vIn7 = T_AnnotatedType_vIn7 +data T_AnnotatedType_vOut7 = T_AnnotatedType_vOut7 (AnnotatedType) +{-# NOINLINE sem_AnnotatedType_AnnotatedType #-} +sem_AnnotatedType_AnnotatedType :: T_Range -> (Bool) -> T_Type -> T_AnnotatedType +sem_AnnotatedType_AnnotatedType arg_range_ arg_strict_ arg_type_ = T_AnnotatedType (return st8) where + {-# NOINLINE st8 #-} + st8 = let + v7 :: T_AnnotatedType_v7 + v7 = \ (T_AnnotatedType_vIn7 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule23 _rangeIself _typeIself arg_strict_ + _lhsOself :: AnnotatedType + _lhsOself = rule24 _self + __result_ = T_AnnotatedType_vOut7 _lhsOself + in __result_ ) + in C_AnnotatedType_s8 v7 + {-# INLINE rule23 #-} + rule23 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) strict_ -> + AnnotatedType_AnnotatedType _rangeIself strict_ _typeIself + {-# INLINE rule24 #-} + rule24 = \ _self -> + _self + +-- AnnotatedTypes ---------------------------------------------- +-- wrapper +data Inh_AnnotatedTypes = Inh_AnnotatedTypes { } +data Syn_AnnotatedTypes = Syn_AnnotatedTypes { length_Syn_AnnotatedTypes :: (Int), self_Syn_AnnotatedTypes :: (AnnotatedTypes) } +{-# INLINABLE wrap_AnnotatedTypes #-} +wrap_AnnotatedTypes :: T_AnnotatedTypes -> Inh_AnnotatedTypes -> (Syn_AnnotatedTypes ) +wrap_AnnotatedTypes (T_AnnotatedTypes act) (Inh_AnnotatedTypes ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedTypes_vIn10 + (T_AnnotatedTypes_vOut10 _lhsOlength _lhsOself) <- return (inv_AnnotatedTypes_s11 sem arg) + return (Syn_AnnotatedTypes _lhsOlength _lhsOself) + ) + +-- cata +{-# NOINLINE sem_AnnotatedTypes #-} +sem_AnnotatedTypes :: AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes list = Prelude.foldr sem_AnnotatedTypes_Cons sem_AnnotatedTypes_Nil (Prelude.map sem_AnnotatedType list) + +-- semantic domain +newtype T_AnnotatedTypes = T_AnnotatedTypes { + attach_T_AnnotatedTypes :: Identity (T_AnnotatedTypes_s11 ) + } +newtype T_AnnotatedTypes_s11 = C_AnnotatedTypes_s11 { + inv_AnnotatedTypes_s11 :: (T_AnnotatedTypes_v10 ) + } +data T_AnnotatedTypes_s12 = C_AnnotatedTypes_s12 +type T_AnnotatedTypes_v10 = (T_AnnotatedTypes_vIn10 ) -> (T_AnnotatedTypes_vOut10 ) +data T_AnnotatedTypes_vIn10 = T_AnnotatedTypes_vIn10 +data T_AnnotatedTypes_vOut10 = T_AnnotatedTypes_vOut10 (Int) (AnnotatedTypes) +{-# NOINLINE sem_AnnotatedTypes_Cons #-} +sem_AnnotatedTypes_Cons :: T_AnnotatedType -> T_AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes_Cons arg_hd_ arg_tl_ = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _hdX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_hd_)) + _tlX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_tl_)) + (T_AnnotatedType_vOut7 _hdIself) = inv_AnnotatedType_s8 _hdX8 (T_AnnotatedType_vIn7 ) + (T_AnnotatedTypes_vOut10 _tlIlength _tlIself) = inv_AnnotatedTypes_s11 _tlX11 (T_AnnotatedTypes_vIn10 ) + _lhsOlength :: Int + _lhsOlength = rule25 _tlIlength + _self = rule26 _hdIself _tlIself + _lhsOself :: AnnotatedTypes + _lhsOself = rule27 _self + __result_ = T_AnnotatedTypes_vOut10 _lhsOlength _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule25 #-} + rule25 = \ ((_tlIlength) :: Int) -> + 1 + _tlIlength + {-# INLINE rule26 #-} + rule26 = \ ((_hdIself) :: AnnotatedType) ((_tlIself) :: AnnotatedTypes) -> + (:) _hdIself _tlIself + {-# INLINE rule27 #-} + rule27 = \ _self -> + _self +{-# NOINLINE sem_AnnotatedTypes_Nil #-} +sem_AnnotatedTypes_Nil :: T_AnnotatedTypes +sem_AnnotatedTypes_Nil = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _lhsOlength :: Int + _lhsOlength = rule28 () + _self = rule29 () + _lhsOself :: AnnotatedTypes + _lhsOself = rule30 _self + __result_ = T_AnnotatedTypes_vOut10 _lhsOlength _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule28 #-} + rule28 = \ (_ :: ()) -> + 0 + {-# INLINE rule29 #-} + rule29 = \ (_ :: ()) -> + [] + {-# INLINE rule30 #-} + rule30 = \ _self -> + _self + +-- Body -------------------------------------------------------- +-- wrapper +data Inh_Body = Inh_Body { dictionaryEnv_Inh_Body :: (DictionaryEnvironment), importEnv_Inh_Body :: (ImportEnvironment) } +data Syn_Body = Syn_Body { decls_Syn_Body :: ( [CoreDecl] ), self_Syn_Body :: (Body) } +{-# INLINABLE wrap_Body #-} +wrap_Body :: T_Body -> Inh_Body -> (Syn_Body ) +wrap_Body (T_Body act) (Inh_Body _lhsIdictionaryEnv _lhsIimportEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Body_vIn13 _lhsIdictionaryEnv _lhsIimportEnv + (T_Body_vOut13 _lhsOdecls _lhsOself) <- return (inv_Body_s14 sem arg) + return (Syn_Body _lhsOdecls _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Body #-} +sem_Body :: Body -> T_Body +sem_Body ( Body_Hole range_ id_ ) = sem_Body_Hole ( sem_Range range_ ) id_ +sem_Body ( Body_Body range_ importdeclarations_ declarations_ ) = sem_Body_Body ( sem_Range range_ ) ( sem_ImportDeclarations importdeclarations_ ) ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_Body = T_Body { + attach_T_Body :: Identity (T_Body_s14 ) + } +newtype T_Body_s14 = C_Body_s14 { + inv_Body_s14 :: (T_Body_v13 ) + } +data T_Body_s15 = C_Body_s15 +type T_Body_v13 = (T_Body_vIn13 ) -> (T_Body_vOut13 ) +data T_Body_vIn13 = T_Body_vIn13 (DictionaryEnvironment) (ImportEnvironment) +data T_Body_vOut13 = T_Body_vOut13 ( [CoreDecl] ) (Body) +{-# NOINLINE sem_Body_Hole #-} +sem_Body_Hole :: T_Range -> (Integer) -> T_Body +sem_Body_Hole arg_range_ arg_id_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 _lhsIdictionaryEnv _lhsIimportEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule31 () + _self = rule32 _rangeIself arg_id_ + _lhsOself :: Body + _lhsOself = rule33 _self + __result_ = T_Body_vOut13 _lhsOdecls _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule31 #-} + rule31 = \ (_ :: ()) -> + [] + {-# INLINE rule32 #-} + rule32 = \ ((_rangeIself) :: Range) id_ -> + Body_Hole _rangeIself id_ + {-# INLINE rule33 #-} + rule33 = \ _self -> + _self +{-# NOINLINE sem_Body_Body #-} +sem_Body_Body :: T_Range -> T_ImportDeclarations -> T_Declarations -> T_Body +sem_Body_Body arg_range_ arg_importdeclarations_ arg_declarations_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 _lhsIdictionaryEnv _lhsIimportEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importdeclarationsX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_importdeclarations_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ImportDeclarations_vOut73 _importdeclarationsIself) = inv_ImportDeclarations_s74 _importdeclarationsX74 (T_ImportDeclarations_vIn73 ) + (T_Declarations_vOut31 _declarationsIdecls _declarationsIpatBindNr _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOdictionaryEnv _declarationsOimportEnv _declarationsOisTopLevel _declarationsOpatBindNr) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule34 _declarationsIdecls + _declarationsOpatBindNr = rule35 () + _declarationsOisTopLevel = rule36 () + _self = rule37 _declarationsIself _importdeclarationsIself _rangeIself + _lhsOself :: Body + _lhsOself = rule38 _self + _declarationsOdictionaryEnv = rule39 _lhsIdictionaryEnv + _declarationsOimportEnv = rule40 _lhsIimportEnv + __result_ = T_Body_vOut13 _lhsOdecls _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule34 #-} + rule34 = \ ((_declarationsIdecls) :: [CoreDecl] ) -> + _declarationsIdecls + {-# INLINE rule35 #-} + rule35 = \ (_ :: ()) -> + 0 + {-# INLINE rule36 #-} + rule36 = \ (_ :: ()) -> + True + {-# INLINE rule37 #-} + rule37 = \ ((_declarationsIself) :: Declarations) ((_importdeclarationsIself) :: ImportDeclarations) ((_rangeIself) :: Range) -> + Body_Body _rangeIself _importdeclarationsIself _declarationsIself + {-# INLINE rule38 #-} + rule38 = \ _self -> + _self + {-# INLINE rule39 #-} + rule39 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule40 #-} + rule40 = \ ((_lhsIimportEnv) :: ImportEnvironment) -> + _lhsIimportEnv + +-- Constructor ------------------------------------------------- +-- wrapper +data Inh_Constructor = Inh_Constructor { dataTypeName_Inh_Constructor :: (Name), dictionaryEnv_Inh_Constructor :: (DictionaryEnvironment), importEnv_Inh_Constructor :: (ImportEnvironment), tag_Inh_Constructor :: (Int) } +data Syn_Constructor = Syn_Constructor { cons_Syn_Constructor :: ( [(Id, CoreDecl)] ), self_Syn_Constructor :: (Constructor) } +{-# INLINABLE wrap_Constructor #-} +wrap_Constructor :: T_Constructor -> Inh_Constructor -> (Syn_Constructor ) +wrap_Constructor (T_Constructor act) (Inh_Constructor _lhsIdataTypeName _lhsIdictionaryEnv _lhsIimportEnv _lhsItag) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructor_vIn16 _lhsIdataTypeName _lhsIdictionaryEnv _lhsIimportEnv _lhsItag + (T_Constructor_vOut16 _lhsOcons _lhsOself) <- return (inv_Constructor_s17 sem arg) + return (Syn_Constructor _lhsOcons _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructor #-} +sem_Constructor :: Constructor -> T_Constructor +sem_Constructor ( Constructor_Constructor range_ constructor_ types_ ) = sem_Constructor_Constructor ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_AnnotatedTypes types_ ) +sem_Constructor ( Constructor_Infix range_ leftType_ constructorOperator_ rightType_ ) = sem_Constructor_Infix ( sem_Range range_ ) ( sem_AnnotatedType leftType_ ) ( sem_Name constructorOperator_ ) ( sem_AnnotatedType rightType_ ) +sem_Constructor ( Constructor_Record range_ constructor_ fieldDeclarations_ ) = sem_Constructor_Record ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_FieldDeclarations fieldDeclarations_ ) + +-- semantic domain +newtype T_Constructor = T_Constructor { + attach_T_Constructor :: Identity (T_Constructor_s17 ) + } +newtype T_Constructor_s17 = C_Constructor_s17 { + inv_Constructor_s17 :: (T_Constructor_v16 ) + } +data T_Constructor_s18 = C_Constructor_s18 +type T_Constructor_v16 = (T_Constructor_vIn16 ) -> (T_Constructor_vOut16 ) +data T_Constructor_vIn16 = T_Constructor_vIn16 (Name) (DictionaryEnvironment) (ImportEnvironment) (Int) +data T_Constructor_vOut16 = T_Constructor_vOut16 ( [(Id, CoreDecl)] ) (Constructor) +{-# NOINLINE sem_Constructor_Constructor #-} +sem_Constructor_Constructor :: T_Range -> T_Name -> T_AnnotatedTypes -> T_Constructor +sem_Constructor_Constructor arg_range_ arg_constructor_ arg_types_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIdataTypeName _lhsIdictionaryEnv _lhsIimportEnv _lhsItag) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _typesX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_AnnotatedTypes_vOut10 _typesIlength _typesIself) = inv_AnnotatedTypes_s11 _typesX11 (T_AnnotatedTypes_vIn10 ) + _lhsOcons :: [(Id, CoreDecl)] + _lhsOcons = rule41 _constructorIself _lhsIdataTypeName _lhsIimportEnv _lhsItag _typesIlength + _self = rule42 _constructorIself _rangeIself _typesIself + _lhsOself :: Constructor + _lhsOself = rule43 _self + __result_ = T_Constructor_vOut16 _lhsOcons _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule41 #-} + rule41 = \ ((_constructorIself) :: Name) ((_lhsIdataTypeName) :: Name) ((_lhsIimportEnv) :: ImportEnvironment) ((_lhsItag) :: Int) ((_typesIlength) :: Int) -> + [ (idFromName _constructorIself, Core.DeclCon + { Core.declName = idFromName _constructorIself + , Core.declAccess = Core.private + , Core.declArity = _typesIlength + , Core.conTag = _lhsItag + , Core.declCustoms = constructorCustoms + _lhsIdataTypeName + _constructorIself + (valueConstructors _lhsIimportEnv) + } + ) + ] + {-# INLINE rule42 #-} + rule42 = \ ((_constructorIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: AnnotatedTypes) -> + Constructor_Constructor _rangeIself _constructorIself _typesIself + {-# INLINE rule43 #-} + rule43 = \ _self -> + _self +{-# NOINLINE sem_Constructor_Infix #-} +sem_Constructor_Infix :: T_Range -> T_AnnotatedType -> T_Name -> T_AnnotatedType -> T_Constructor +sem_Constructor_Infix arg_range_ arg_leftType_ arg_constructorOperator_ arg_rightType_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIdataTypeName _lhsIdictionaryEnv _lhsIimportEnv _lhsItag) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_leftType_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_rightType_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_AnnotatedType_vOut7 _leftTypeIself) = inv_AnnotatedType_s8 _leftTypeX8 (T_AnnotatedType_vIn7 ) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_AnnotatedType_vOut7 _rightTypeIself) = inv_AnnotatedType_s8 _rightTypeX8 (T_AnnotatedType_vIn7 ) + _lhsOcons :: [(Id, CoreDecl)] + _lhsOcons = rule44 _constructorOperatorIself _lhsIdataTypeName _lhsIimportEnv _lhsItag + _self = rule45 _constructorOperatorIself _leftTypeIself _rangeIself _rightTypeIself + _lhsOself :: Constructor + _lhsOself = rule46 _self + __result_ = T_Constructor_vOut16 _lhsOcons _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule44 #-} + rule44 = \ ((_constructorOperatorIself) :: Name) ((_lhsIdataTypeName) :: Name) ((_lhsIimportEnv) :: ImportEnvironment) ((_lhsItag) :: Int) -> + [ (idFromName _constructorOperatorIself, Core.DeclCon + { Core.declName = idFromName _constructorOperatorIself + , Core.declAccess = Core.private + , Core.declArity = 2 + , Core.conTag = _lhsItag + , Core.declCustoms = constructorCustoms + _lhsIdataTypeName + _constructorOperatorIself + (valueConstructors _lhsIimportEnv) + } + ) + ] + {-# INLINE rule45 #-} + rule45 = \ ((_constructorOperatorIself) :: Name) ((_leftTypeIself) :: AnnotatedType) ((_rangeIself) :: Range) ((_rightTypeIself) :: AnnotatedType) -> + Constructor_Infix _rangeIself _leftTypeIself _constructorOperatorIself _rightTypeIself + {-# INLINE rule46 #-} + rule46 = \ _self -> + _self +{-# NOINLINE sem_Constructor_Record #-} +sem_Constructor_Record :: T_Range -> T_Name -> T_FieldDeclarations -> T_Constructor +sem_Constructor_Record arg_range_ arg_constructor_ arg_fieldDeclarations_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIdataTypeName _lhsIdictionaryEnv _lhsIimportEnv _lhsItag) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _fieldDeclarationsX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_fieldDeclarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_FieldDeclarations_vOut49 _fieldDeclarationsIself) = inv_FieldDeclarations_s50 _fieldDeclarationsX50 (T_FieldDeclarations_vIn49 ) + _lhsOcons :: [(Id, CoreDecl)] + _lhsOcons = rule47 () + _self = rule48 _constructorIself _fieldDeclarationsIself _rangeIself + _lhsOself :: Constructor + _lhsOself = rule49 _self + __result_ = T_Constructor_vOut16 _lhsOcons _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule47 #-} + rule47 = \ (_ :: ()) -> + internalError "ToCoreDecl" "Constructor" "records not supported" + {-# INLINE rule48 #-} + rule48 = \ ((_constructorIself) :: Name) ((_fieldDeclarationsIself) :: FieldDeclarations) ((_rangeIself) :: Range) -> + Constructor_Record _rangeIself _constructorIself _fieldDeclarationsIself + {-# INLINE rule49 #-} + rule49 = \ _self -> + _self + +-- Constructors ------------------------------------------------ +-- wrapper +data Inh_Constructors = Inh_Constructors { dataTypeName_Inh_Constructors :: (Name), dictionaryEnv_Inh_Constructors :: (DictionaryEnvironment), importEnv_Inh_Constructors :: (ImportEnvironment), tag_Inh_Constructors :: (Int) } +data Syn_Constructors = Syn_Constructors { cons_Syn_Constructors :: ( [(Id, CoreDecl)] ), self_Syn_Constructors :: (Constructors) } +{-# INLINABLE wrap_Constructors #-} +wrap_Constructors :: T_Constructors -> Inh_Constructors -> (Syn_Constructors ) +wrap_Constructors (T_Constructors act) (Inh_Constructors _lhsIdataTypeName _lhsIdictionaryEnv _lhsIimportEnv _lhsItag) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructors_vIn19 _lhsIdataTypeName _lhsIdictionaryEnv _lhsIimportEnv _lhsItag + (T_Constructors_vOut19 _lhsOcons _lhsOself) <- return (inv_Constructors_s20 sem arg) + return (Syn_Constructors _lhsOcons _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructors #-} +sem_Constructors :: Constructors -> T_Constructors +sem_Constructors list = Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list) + +-- semantic domain +newtype T_Constructors = T_Constructors { + attach_T_Constructors :: Identity (T_Constructors_s20 ) + } +newtype T_Constructors_s20 = C_Constructors_s20 { + inv_Constructors_s20 :: (T_Constructors_v19 ) + } +data T_Constructors_s21 = C_Constructors_s21 +type T_Constructors_v19 = (T_Constructors_vIn19 ) -> (T_Constructors_vOut19 ) +data T_Constructors_vIn19 = T_Constructors_vIn19 (Name) (DictionaryEnvironment) (ImportEnvironment) (Int) +data T_Constructors_vOut19 = T_Constructors_vOut19 ( [(Id, CoreDecl)] ) (Constructors) +{-# NOINLINE sem_Constructors_Cons #-} +sem_Constructors_Cons :: T_Constructor -> T_Constructors -> T_Constructors +sem_Constructors_Cons arg_hd_ arg_tl_ = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 _lhsIdataTypeName _lhsIdictionaryEnv _lhsIimportEnv _lhsItag) -> ( let + _hdX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_hd_)) + _tlX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_tl_)) + (T_Constructor_vOut16 _hdIcons _hdIself) = inv_Constructor_s17 _hdX17 (T_Constructor_vIn16 _hdOdataTypeName _hdOdictionaryEnv _hdOimportEnv _hdOtag) + (T_Constructors_vOut19 _tlIcons _tlIself) = inv_Constructors_s20 _tlX20 (T_Constructors_vIn19 _tlOdataTypeName _tlOdictionaryEnv _tlOimportEnv _tlOtag) + _hdOtag = rule50 _lhsItag + _tlOtag = rule51 _lhsItag + _lhsOcons :: [(Id, CoreDecl)] + _lhsOcons = rule52 _hdIcons _tlIcons + _self = rule53 _hdIself _tlIself + _lhsOself :: Constructors + _lhsOself = rule54 _self + _hdOdataTypeName = rule55 _lhsIdataTypeName + _hdOdictionaryEnv = rule56 _lhsIdictionaryEnv + _hdOimportEnv = rule57 _lhsIimportEnv + _tlOdataTypeName = rule58 _lhsIdataTypeName + _tlOdictionaryEnv = rule59 _lhsIdictionaryEnv + _tlOimportEnv = rule60 _lhsIimportEnv + __result_ = T_Constructors_vOut19 _lhsOcons _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule50 #-} + rule50 = \ ((_lhsItag) :: Int) -> + _lhsItag + {-# INLINE rule51 #-} + rule51 = \ ((_lhsItag) :: Int) -> + _lhsItag + 1 + {-# INLINE rule52 #-} + rule52 = \ ((_hdIcons) :: [(Id, CoreDecl)] ) ((_tlIcons) :: [(Id, CoreDecl)] ) -> + _hdIcons ++ _tlIcons + {-# INLINE rule53 #-} + rule53 = \ ((_hdIself) :: Constructor) ((_tlIself) :: Constructors) -> + (:) _hdIself _tlIself + {-# INLINE rule54 #-} + rule54 = \ _self -> + _self + {-# INLINE rule55 #-} + rule55 = \ ((_lhsIdataTypeName) :: Name) -> + _lhsIdataTypeName + {-# INLINE rule56 #-} + rule56 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule57 #-} + rule57 = \ ((_lhsIimportEnv) :: ImportEnvironment) -> + _lhsIimportEnv + {-# INLINE rule58 #-} + rule58 = \ ((_lhsIdataTypeName) :: Name) -> + _lhsIdataTypeName + {-# INLINE rule59 #-} + rule59 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule60 #-} + rule60 = \ ((_lhsIimportEnv) :: ImportEnvironment) -> + _lhsIimportEnv +{-# NOINLINE sem_Constructors_Nil #-} +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 _lhsIdataTypeName _lhsIdictionaryEnv _lhsIimportEnv _lhsItag) -> ( let + _lhsOcons :: [(Id, CoreDecl)] + _lhsOcons = rule61 () + _self = rule62 () + _lhsOself :: Constructors + _lhsOself = rule63 _self + __result_ = T_Constructors_vOut19 _lhsOcons _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule61 #-} + rule61 = \ (_ :: ()) -> + [] + {-# INLINE rule62 #-} + rule62 = \ (_ :: ()) -> + [] + {-# INLINE rule63 #-} + rule63 = \ _self -> + _self + +-- ContextItem ------------------------------------------------- +-- wrapper +data Inh_ContextItem = Inh_ContextItem { } +data Syn_ContextItem = Syn_ContextItem { self_Syn_ContextItem :: (ContextItem) } +{-# INLINABLE wrap_ContextItem #-} +wrap_ContextItem :: T_ContextItem -> Inh_ContextItem -> (Syn_ContextItem ) +wrap_ContextItem (T_ContextItem act) (Inh_ContextItem ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItem_vIn22 + (T_ContextItem_vOut22 _lhsOself) <- return (inv_ContextItem_s23 sem arg) + return (Syn_ContextItem _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItem #-} +sem_ContextItem :: ContextItem -> T_ContextItem +sem_ContextItem ( ContextItem_ContextItem range_ name_ types_ ) = sem_ContextItem_ContextItem ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Types types_ ) + +-- semantic domain +newtype T_ContextItem = T_ContextItem { + attach_T_ContextItem :: Identity (T_ContextItem_s23 ) + } +newtype T_ContextItem_s23 = C_ContextItem_s23 { + inv_ContextItem_s23 :: (T_ContextItem_v22 ) + } +data T_ContextItem_s24 = C_ContextItem_s24 +type T_ContextItem_v22 = (T_ContextItem_vIn22 ) -> (T_ContextItem_vOut22 ) +data T_ContextItem_vIn22 = T_ContextItem_vIn22 +data T_ContextItem_vOut22 = T_ContextItem_vOut22 (ContextItem) +{-# NOINLINE sem_ContextItem_ContextItem #-} +sem_ContextItem_ContextItem :: T_Range -> T_Name -> T_Types -> T_ContextItem +sem_ContextItem_ContextItem arg_range_ arg_name_ arg_types_ = T_ContextItem (return st23) where + {-# NOINLINE st23 #-} + st23 = let + v22 :: T_ContextItem_v22 + v22 = \ (T_ContextItem_vIn22 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _self = rule64 _nameIself _rangeIself _typesIself + _lhsOself :: ContextItem + _lhsOself = rule65 _self + __result_ = T_ContextItem_vOut22 _lhsOself + in __result_ ) + in C_ContextItem_s23 v22 + {-# INLINE rule64 #-} + rule64 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + ContextItem_ContextItem _rangeIself _nameIself _typesIself + {-# INLINE rule65 #-} + rule65 = \ _self -> + _self + +-- ContextItems ------------------------------------------------ +-- wrapper +data Inh_ContextItems = Inh_ContextItems { } +data Syn_ContextItems = Syn_ContextItems { self_Syn_ContextItems :: (ContextItems) } +{-# INLINABLE wrap_ContextItems #-} +wrap_ContextItems :: T_ContextItems -> Inh_ContextItems -> (Syn_ContextItems ) +wrap_ContextItems (T_ContextItems act) (Inh_ContextItems ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItems_vIn25 + (T_ContextItems_vOut25 _lhsOself) <- return (inv_ContextItems_s26 sem arg) + return (Syn_ContextItems _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItems #-} +sem_ContextItems :: ContextItems -> T_ContextItems +sem_ContextItems list = Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list) + +-- semantic domain +newtype T_ContextItems = T_ContextItems { + attach_T_ContextItems :: Identity (T_ContextItems_s26 ) + } +newtype T_ContextItems_s26 = C_ContextItems_s26 { + inv_ContextItems_s26 :: (T_ContextItems_v25 ) + } +data T_ContextItems_s27 = C_ContextItems_s27 +type T_ContextItems_v25 = (T_ContextItems_vIn25 ) -> (T_ContextItems_vOut25 ) +data T_ContextItems_vIn25 = T_ContextItems_vIn25 +data T_ContextItems_vOut25 = T_ContextItems_vOut25 (ContextItems) +{-# NOINLINE sem_ContextItems_Cons #-} +sem_ContextItems_Cons :: T_ContextItem -> T_ContextItems -> T_ContextItems +sem_ContextItems_Cons arg_hd_ arg_tl_ = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _hdX23 = Control.Monad.Identity.runIdentity (attach_T_ContextItem (arg_hd_)) + _tlX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_tl_)) + (T_ContextItem_vOut22 _hdIself) = inv_ContextItem_s23 _hdX23 (T_ContextItem_vIn22 ) + (T_ContextItems_vOut25 _tlIself) = inv_ContextItems_s26 _tlX26 (T_ContextItems_vIn25 ) + _self = rule66 _hdIself _tlIself + _lhsOself :: ContextItems + _lhsOself = rule67 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule66 #-} + rule66 = \ ((_hdIself) :: ContextItem) ((_tlIself) :: ContextItems) -> + (:) _hdIself _tlIself + {-# INLINE rule67 #-} + rule67 = \ _self -> + _self +{-# NOINLINE sem_ContextItems_Nil #-} +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _self = rule68 () + _lhsOself :: ContextItems + _lhsOself = rule69 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule68 #-} + rule68 = \ (_ :: ()) -> + [] + {-# INLINE rule69 #-} + rule69 = \ _self -> + _self + +-- Declaration ------------------------------------------------- +-- wrapper +data Inh_Declaration = Inh_Declaration { dictionaryEnv_Inh_Declaration :: (DictionaryEnvironment), importEnv_Inh_Declaration :: (ImportEnvironment), isTopLevel_Inh_Declaration :: (Bool), patBindNr_Inh_Declaration :: (Int) } +data Syn_Declaration = Syn_Declaration { decls_Syn_Declaration :: ( [CoreDecl] ), patBindNr_Syn_Declaration :: (Int), self_Syn_Declaration :: (Declaration) } +{-# INLINABLE wrap_Declaration #-} +wrap_Declaration :: T_Declaration -> Inh_Declaration -> (Syn_Declaration ) +wrap_Declaration (T_Declaration act) (Inh_Declaration _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr + (T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself) <- return (inv_Declaration_s29 sem arg) + return (Syn_Declaration _lhsOdecls _lhsOpatBindNr _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declaration #-} +sem_Declaration :: Declaration -> T_Declaration +sem_Declaration ( Declaration_Hole range_ id_ ) = sem_Declaration_Hole ( sem_Range range_ ) id_ +sem_Declaration ( Declaration_Type range_ simpletype_ type_ ) = sem_Declaration_Type ( sem_Range range_ ) ( sem_SimpleType simpletype_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Data range_ context_ simpletype_ constructors_ derivings_ ) = sem_Declaration_Data ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructors constructors_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Newtype range_ context_ simpletype_ constructor_ derivings_ ) = sem_Declaration_Newtype ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructor constructor_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Class range_ context_ simpletype_ where_ ) = sem_Declaration_Class ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Instance range_ context_ name_ types_ where_ ) = sem_Declaration_Instance ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Name name_ ) ( sem_Types types_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Default range_ types_ ) = sem_Declaration_Default ( sem_Range range_ ) ( sem_Types types_ ) +sem_Declaration ( Declaration_FunctionBindings range_ bindings_ ) = sem_Declaration_FunctionBindings ( sem_Range range_ ) ( sem_FunctionBindings bindings_ ) +sem_Declaration ( Declaration_PatternBinding range_ pattern_ righthandside_ ) = sem_Declaration_PatternBinding ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Declaration ( Declaration_TypeSignature range_ names_ type_ ) = sem_Declaration_TypeSignature ( sem_Range range_ ) ( sem_Names names_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Fixity range_ fixity_ priority_ operators_ ) = sem_Declaration_Fixity ( sem_Range range_ ) ( sem_Fixity fixity_ ) ( sem_MaybeInt priority_ ) ( sem_Names operators_ ) +sem_Declaration ( Declaration_Empty range_ ) = sem_Declaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Declaration = T_Declaration { + attach_T_Declaration :: Identity (T_Declaration_s29 ) + } +newtype T_Declaration_s29 = C_Declaration_s29 { + inv_Declaration_s29 :: (T_Declaration_v28 ) + } +data T_Declaration_s30 = C_Declaration_s30 +type T_Declaration_v28 = (T_Declaration_vIn28 ) -> (T_Declaration_vOut28 ) +data T_Declaration_vIn28 = T_Declaration_vIn28 (DictionaryEnvironment) (ImportEnvironment) (Bool) (Int) +data T_Declaration_vOut28 = T_Declaration_vOut28 ( [CoreDecl] ) (Int) (Declaration) +{-# NOINLINE sem_Declaration_Hole #-} +sem_Declaration_Hole :: T_Range -> (Integer) -> T_Declaration +sem_Declaration_Hole arg_range_ arg_id_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule70 () + _self = rule71 _rangeIself arg_id_ + _lhsOself :: Declaration + _lhsOself = rule72 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule73 _lhsIpatBindNr + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule70 #-} + rule70 = \ (_ :: ()) -> + [] + {-# INLINE rule71 #-} + rule71 = \ ((_rangeIself) :: Range) id_ -> + Declaration_Hole _rangeIself id_ + {-# INLINE rule72 #-} + rule72 = \ _self -> + _self + {-# INLINE rule73 #-} + rule73 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr +{-# NOINLINE sem_Declaration_Type #-} +sem_Declaration_Type :: T_Range -> T_SimpleType -> T_Type -> T_Declaration +sem_Declaration_Type arg_range_ arg_simpletype_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule74 _self _simpletypeIname _simpletypeIself _simpletypeItypevariables _typeIself + _self = rule75 _rangeIself _simpletypeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule76 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule77 _lhsIpatBindNr + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule74 #-} + rule74 = \ _self ((_simpletypeIname) :: Name) ((_simpletypeIself) :: SimpleType) ((_simpletypeItypevariables) :: Names) ((_typeIself) :: Type) -> + let + (t1,[t2]) = convertFromSimpleTypeAndTypes _simpletypeIself [_typeIself] + allTypeVars = ftv [t1,t2] + (ts1,ts2) = ( Quantification (allTypeVars, [], [] .=>. t1) :: TpScheme + , Quantification (allTypeVars, [], [] .=>. t2) :: TpScheme + ) + in + [ Core.DeclCustom + { Core.declName = idFromString (getNameName _simpletypeIname) + , Core.declAccess = Core.private + , Core.declKind = Core.DeclKindCustom (idFromString "typedecl") + , Core.declCustoms = + [ Core.CustomBytes + (Byte.bytesFromString + ( show ts1 + ++ " = " + ++ show ts2 + ) + ) + , Core.CustomInt + (length _simpletypeItypevariables) + ] + } + ] + ++ + [ DerivingShow.typeShowFunction _self ] + {-# INLINE rule75 #-} + rule75 = \ ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_typeIself) :: Type) -> + Declaration_Type _rangeIself _simpletypeIself _typeIself + {-# INLINE rule76 #-} + rule76 = \ _self -> + _self + {-# INLINE rule77 #-} + rule77 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr +{-# NOINLINE sem_Declaration_Data #-} +sem_Declaration_Data :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructors -> T_Names -> T_Declaration +sem_Declaration_Data arg_range_ arg_context_ arg_simpletype_ arg_constructors_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorsX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_constructors_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructors_vOut19 _constructorsIcons _constructorsIself) = inv_Constructors_s20 _constructorsX20 (T_Constructors_vIn19 _constructorsOdataTypeName _constructorsOdictionaryEnv _constructorsOimportEnv _constructorsOtag) + (T_Names_vOut115 _derivingsInames _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _constructorsOtag = rule78 () + _constructorsOdataTypeName = rule79 _simpletypeIname + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule80 _constructorsIcons _derivingsIself _self _simpletypeIname _simpletypeItypevariables + _self = rule81 _constructorsIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule82 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule83 _lhsIpatBindNr + _constructorsOdictionaryEnv = rule84 _lhsIdictionaryEnv + _constructorsOimportEnv = rule85 _lhsIimportEnv + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule78 #-} + rule78 = \ (_ :: ()) -> + 0 + {-# INLINE rule79 #-} + rule79 = \ ((_simpletypeIname) :: Name) -> + _simpletypeIname + {-# INLINE rule80 #-} + rule80 = \ ((_constructorsIcons) :: [(Id, CoreDecl)] ) ((_derivingsIself) :: Names) _self ((_simpletypeIname) :: Name) ((_simpletypeItypevariables) :: Names) -> + map snd _constructorsIcons + ++ + [ Core.DeclCustom + { Core.declName = idFromString (getNameName _simpletypeIname) + , Core.declAccess = Core.private + , Core.declKind = Core.DeclKindCustom (idFromString "data") + , Core.declCustoms = [Core.CustomInt (length _simpletypeItypevariables)] + } + ] + ++ + [ DerivingShow.dataShowFunction _self ] + ++ + (if "Show" `elem` map show _derivingsIself + then [ DerivingShow.dataDictionary _self ] + else [] + ) + ++ + (if "Eq" `elem` map show _derivingsIself + then [ DerivingEq.dataDictionary _self ] + else [] + ) + {-# INLINE rule81 #-} + rule81 = \ ((_constructorsIself) :: Constructors) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Data _rangeIself _contextIself _simpletypeIself _constructorsIself _derivingsIself + {-# INLINE rule82 #-} + rule82 = \ _self -> + _self + {-# INLINE rule83 #-} + rule83 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr + {-# INLINE rule84 #-} + rule84 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule85 #-} + rule85 = \ ((_lhsIimportEnv) :: ImportEnvironment) -> + _lhsIimportEnv +{-# NOINLINE sem_Declaration_Newtype #-} +sem_Declaration_Newtype :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructor -> T_Names -> T_Declaration +sem_Declaration_Newtype arg_range_ arg_context_ arg_simpletype_ arg_constructor_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_constructor_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructor_vOut16 _constructorIcons _constructorIself) = inv_Constructor_s17 _constructorX17 (T_Constructor_vIn16 _constructorOdataTypeName _constructorOdictionaryEnv _constructorOimportEnv _constructorOtag) + (T_Names_vOut115 _derivingsInames _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule86 () + _constructorOtag = rule87 () + _constructorOdataTypeName = rule88 _simpletypeIname + _self = rule89 _constructorIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule90 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule91 _lhsIpatBindNr + _constructorOdictionaryEnv = rule92 _lhsIdictionaryEnv + _constructorOimportEnv = rule93 _lhsIimportEnv + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule86 #-} + rule86 = \ (_ :: ()) -> + internalError "ToCoreDecl" "Declaration" "'newType' not supported" + {-# INLINE rule87 #-} + rule87 = \ (_ :: ()) -> + 0 + {-# INLINE rule88 #-} + rule88 = \ ((_simpletypeIname) :: Name) -> + _simpletypeIname + {-# INLINE rule89 #-} + rule89 = \ ((_constructorIself) :: Constructor) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Newtype _rangeIself _contextIself _simpletypeIself _constructorIself _derivingsIself + {-# INLINE rule90 #-} + rule90 = \ _self -> + _self + {-# INLINE rule91 #-} + rule91 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr + {-# INLINE rule92 #-} + rule92 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule93 #-} + rule93 = \ ((_lhsIimportEnv) :: ImportEnvironment) -> + _lhsIimportEnv +{-# NOINLINE sem_Declaration_Class #-} +sem_Declaration_Class :: T_Range -> T_ContextItems -> T_SimpleType -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Class arg_range_ arg_context_ arg_simpletype_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_MaybeDeclarations_vOut88 _whereIcore _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOdictionaryEnv) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule94 () + _self = rule95 _contextIself _rangeIself _simpletypeIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule96 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule97 _lhsIpatBindNr + _whereOdictionaryEnv = rule98 _lhsIdictionaryEnv + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule94 #-} + rule94 = \ (_ :: ()) -> + internalError "ToCoreDecl" "Declaration" "'class' not supported" + {-# INLINE rule95 #-} + rule95 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Class _rangeIself _contextIself _simpletypeIself _whereIself + {-# INLINE rule96 #-} + rule96 = \ _self -> + _self + {-# INLINE rule97 #-} + rule97 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr + {-# INLINE rule98 #-} + rule98 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Declaration_Instance #-} +sem_Declaration_Instance :: T_Range -> T_ContextItems -> T_Name -> T_Types -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Instance arg_range_ arg_context_ arg_name_ arg_types_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + (T_MaybeDeclarations_vOut88 _whereIcore _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOdictionaryEnv) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule99 () + _self = rule100 _contextIself _nameIself _rangeIself _typesIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule101 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule102 _lhsIpatBindNr + _whereOdictionaryEnv = rule103 _lhsIdictionaryEnv + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule99 #-} + rule99 = \ (_ :: ()) -> + internalError "ToCoreDecl" "Declaration" "'instance' not supported" + {-# INLINE rule100 #-} + rule100 = \ ((_contextIself) :: ContextItems) ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Instance _rangeIself _contextIself _nameIself _typesIself _whereIself + {-# INLINE rule101 #-} + rule101 = \ _self -> + _self + {-# INLINE rule102 #-} + rule102 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr + {-# INLINE rule103 #-} + rule103 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Declaration_Default #-} +sem_Declaration_Default :: T_Range -> T_Types -> T_Declaration +sem_Declaration_Default arg_range_ arg_types_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule104 () + _self = rule105 _rangeIself _typesIself + _lhsOself :: Declaration + _lhsOself = rule106 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule107 _lhsIpatBindNr + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule104 #-} + rule104 = \ (_ :: ()) -> + internalError "ToCoreDecl" "Declaration" "'default' not supported" + {-# INLINE rule105 #-} + rule105 = \ ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + Declaration_Default _rangeIself _typesIself + {-# INLINE rule106 #-} + rule106 = \ _self -> + _self + {-# INLINE rule107 #-} + rule107 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr +{-# NOINLINE sem_Declaration_FunctionBindings #-} +sem_Declaration_FunctionBindings :: T_Range -> T_FunctionBindings -> T_Declaration +sem_Declaration_FunctionBindings arg_range_ arg_bindings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _bindingsX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_bindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBindings_vOut58 _bindingsIarity _bindingsIcore _bindingsIname _bindingsIself) = inv_FunctionBindings_s59 _bindingsX59 (T_FunctionBindings_vIn58 _bindingsOdictionaryEnv _bindingsOids _bindingsOrange) + _ids = rule108 _bindingsIarity + _bindingsOids = rule109 _ids + _bindingsOrange = rule110 _rangeIself + _dictionaries = rule111 _bindingsIname _lhsIdictionaryEnv + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule112 _bindingsIcore _bindingsIname _dictionaries _ids _lhsIimportEnv _lhsIisTopLevel + _self = rule113 _bindingsIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule114 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule115 _lhsIpatBindNr + _bindingsOdictionaryEnv = rule116 _lhsIdictionaryEnv + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule108 #-} + rule108 = \ ((_bindingsIarity) :: Int) -> + freshIds "u$" _bindingsIarity + {-# INLINE rule109 #-} + rule109 = \ _ids -> + _ids + {-# INLINE rule110 #-} + rule110 = \ ((_rangeIself) :: Range) -> + _rangeIself + {-# INLINE rule111 #-} + rule111 = \ ((_bindingsIname) :: Name) ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + map predicateToId + (getPredicateForDecl _bindingsIname _lhsIdictionaryEnv) + {-# INLINE rule112 #-} + rule112 = \ ((_bindingsIcore) :: Core.Expr) ((_bindingsIname) :: Name) _dictionaries _ids ((_lhsIimportEnv) :: ImportEnvironment) ((_lhsIisTopLevel) :: Bool) -> + [ Core.DeclValue + { Core.declName = idFromName _bindingsIname + , Core.declAccess = Core.private + , Core.valueEnc = Nothing + , Core.valueValue = foldr Core.Lam _bindingsIcore (_dictionaries ++ _ids) + , Core.declCustoms = toplevelType _bindingsIname _lhsIimportEnv _lhsIisTopLevel + } + ] + {-# INLINE rule113 #-} + rule113 = \ ((_bindingsIself) :: FunctionBindings) ((_rangeIself) :: Range) -> + Declaration_FunctionBindings _rangeIself _bindingsIself + {-# INLINE rule114 #-} + rule114 = \ _self -> + _self + {-# INLINE rule115 #-} + rule115 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr + {-# INLINE rule116 #-} + rule116 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Declaration_PatternBinding #-} +sem_Declaration_PatternBinding :: T_Range -> T_Pattern -> T_RightHandSide -> T_Declaration +sem_Declaration_PatternBinding arg_range_ arg_pattern_ arg_righthandside_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself _patternIvars) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_RightHandSide_vOut148 _righthandsideIcore _righthandsideIisGuarded _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOdictionaryEnv) + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule117 _lhsIpatBindNr + _dictionaries = rule118 _lhsIdictionaryEnv _patternIself + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule119 _dictionaries _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr _patternIself _patternIvars _rangeIself _righthandsideIcore + _self = rule120 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Declaration + _lhsOself = rule121 _self + _righthandsideOdictionaryEnv = rule122 _lhsIdictionaryEnv + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule117 #-} + rule117 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr + 1 + {-# INLINE rule118 #-} + rule118 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) ((_patternIself) :: Pattern) -> + case _patternIself of + Pattern_Variable _ n -> + map predicateToId + (getPredicateForDecl n _lhsIdictionaryEnv) + _ -> [] + {-# INLINE rule119 #-} + rule119 = \ _dictionaries ((_lhsIimportEnv) :: ImportEnvironment) ((_lhsIisTopLevel) :: Bool) ((_lhsIpatBindNr) :: Int) ((_patternIself) :: Pattern) ((_patternIvars) :: [Name] ) ((_rangeIself) :: Range) ((_righthandsideIcore) :: Core.Expr ) -> + case _patternIself of + Pattern_Variable _ n -> + [ Core.DeclValue + { Core.declName = idFromName n + , Core.declAccess = Core.private + , Core.valueEnc = Nothing + , Core.valueValue = + foldr Core.Lam + ( let_ + nextClauseId (patternMatchFail "pattern binding" _rangeIself) + _righthandsideIcore + ) + _dictionaries + , Core.declCustoms = toplevelType n _lhsIimportEnv _lhsIisTopLevel + } + ] + _ -> + Core.DeclValue + { Core.declName = patBindId + , Core.declAccess = Core.private + , Core.valueEnc = Nothing + , Core.valueValue = + let_ + nextClauseId (patternMatchFail "pattern binding" _rangeIself) + _righthandsideIcore + , Core.declCustoms = [custom "type" "patternbinding"] + } + : + [ Core.DeclValue + { Core.declName = idFromName v + , Core.declAccess = Core.private + , Core.valueEnc = Nothing + , Core.valueValue = + (let_ nextClauseId (patternMatchFail "pattern binding" _rangeIself) + (patternToCore (patBindId, _patternIself) (Core.Var (idFromName v))) + ) + , Core.declCustoms = toplevelType v _lhsIimportEnv _lhsIisTopLevel + } + | v <- _patternIvars + ] + where + patBindId = idFromString ("patBind$" ++ show _lhsIpatBindNr) + {-# INLINE rule120 #-} + rule120 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Declaration_PatternBinding _rangeIself _patternIself _righthandsideIself + {-# INLINE rule121 #-} + rule121 = \ _self -> + _self + {-# INLINE rule122 #-} + rule122 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Declaration_TypeSignature #-} +sem_Declaration_TypeSignature :: T_Range -> T_Names -> T_Type -> T_Declaration +sem_Declaration_TypeSignature arg_range_ arg_names_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesInames _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule123 () + _self = rule124 _namesIself _rangeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule125 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule126 _lhsIpatBindNr + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule123 #-} + rule123 = \ (_ :: ()) -> + [] + {-# INLINE rule124 #-} + rule124 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Declaration_TypeSignature _rangeIself _namesIself _typeIself + {-# INLINE rule125 #-} + rule125 = \ _self -> + _self + {-# INLINE rule126 #-} + rule126 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr +{-# NOINLINE sem_Declaration_Fixity #-} +sem_Declaration_Fixity :: T_Range -> T_Fixity -> T_MaybeInt -> T_Names -> T_Declaration +sem_Declaration_Fixity arg_range_ arg_fixity_ arg_priority_ arg_operators_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fixityX53 = Control.Monad.Identity.runIdentity (attach_T_Fixity (arg_fixity_)) + _priorityX101 = Control.Monad.Identity.runIdentity (attach_T_MaybeInt (arg_priority_)) + _operatorsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_operators_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Fixity_vOut52 _fixityIself) = inv_Fixity_s53 _fixityX53 (T_Fixity_vIn52 ) + (T_MaybeInt_vOut100 _priorityIself) = inv_MaybeInt_s101 _priorityX101 (T_MaybeInt_vIn100 ) + (T_Names_vOut115 _operatorsInames _operatorsIself) = inv_Names_s116 _operatorsX116 (T_Names_vIn115 ) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule127 _fixityIself _operatorsIself _priorityIself + _self = rule128 _fixityIself _operatorsIself _priorityIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule129 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule130 _lhsIpatBindNr + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule127 #-} + rule127 = \ ((_fixityIself) :: Fixity) ((_operatorsIself) :: Names) ((_priorityIself) :: MaybeInt) -> + map + ( ( \n -> + Core.DeclCustom + { Core.declName = idFromString n + , Core.declAccess = Core.private + , Core.declKind = (Core.DeclKindCustom . idFromString) "infix" + , Core.declCustoms = + [ Core.CustomInt + ( case _priorityIself of + MaybeInt_Just i -> i + MaybeInt_Nothing -> 9 ) + , (Core.CustomBytes . bytesFromString) + ( case _fixityIself of + Fixity_Infixr _ -> "right" + Fixity_Infixl _ -> "left" + Fixity_Infix _ -> "none" + ) + ] + } + ) + . + getNameName + ) + _operatorsIself + {-# INLINE rule128 #-} + rule128 = \ ((_fixityIself) :: Fixity) ((_operatorsIself) :: Names) ((_priorityIself) :: MaybeInt) ((_rangeIself) :: Range) -> + Declaration_Fixity _rangeIself _fixityIself _priorityIself _operatorsIself + {-# INLINE rule129 #-} + rule129 = \ _self -> + _self + {-# INLINE rule130 #-} + rule130 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr +{-# NOINLINE sem_Declaration_Empty #-} +sem_Declaration_Empty :: T_Range -> T_Declaration +sem_Declaration_Empty arg_range_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule131 () + _self = rule132 _rangeIself + _lhsOself :: Declaration + _lhsOself = rule133 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule134 _lhsIpatBindNr + __result_ = T_Declaration_vOut28 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule131 #-} + rule131 = \ (_ :: ()) -> + internalError "ToCoreDecl" "Declaration" "empty declarations not supported" + {-# INLINE rule132 #-} + rule132 = \ ((_rangeIself) :: Range) -> + Declaration_Empty _rangeIself + {-# INLINE rule133 #-} + rule133 = \ _self -> + _self + {-# INLINE rule134 #-} + rule134 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr + +-- Declarations ------------------------------------------------ +-- wrapper +data Inh_Declarations = Inh_Declarations { dictionaryEnv_Inh_Declarations :: (DictionaryEnvironment), importEnv_Inh_Declarations :: (ImportEnvironment), isTopLevel_Inh_Declarations :: (Bool), patBindNr_Inh_Declarations :: (Int) } +data Syn_Declarations = Syn_Declarations { decls_Syn_Declarations :: ( [CoreDecl] ), patBindNr_Syn_Declarations :: (Int), self_Syn_Declarations :: (Declarations) } +{-# INLINABLE wrap_Declarations #-} +wrap_Declarations :: T_Declarations -> Inh_Declarations -> (Syn_Declarations ) +wrap_Declarations (T_Declarations act) (Inh_Declarations _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declarations_vIn31 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr + (T_Declarations_vOut31 _lhsOdecls _lhsOpatBindNr _lhsOself) <- return (inv_Declarations_s32 sem arg) + return (Syn_Declarations _lhsOdecls _lhsOpatBindNr _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declarations #-} +sem_Declarations :: Declarations -> T_Declarations +sem_Declarations list = Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list) + +-- semantic domain +newtype T_Declarations = T_Declarations { + attach_T_Declarations :: Identity (T_Declarations_s32 ) + } +newtype T_Declarations_s32 = C_Declarations_s32 { + inv_Declarations_s32 :: (T_Declarations_v31 ) + } +data T_Declarations_s33 = C_Declarations_s33 +type T_Declarations_v31 = (T_Declarations_vIn31 ) -> (T_Declarations_vOut31 ) +data T_Declarations_vIn31 = T_Declarations_vIn31 (DictionaryEnvironment) (ImportEnvironment) (Bool) (Int) +data T_Declarations_vOut31 = T_Declarations_vOut31 ( [CoreDecl] ) (Int) (Declarations) +{-# NOINLINE sem_Declarations_Cons #-} +sem_Declarations_Cons :: T_Declaration -> T_Declarations -> T_Declarations +sem_Declarations_Cons arg_hd_ arg_tl_ = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Declaration (arg_hd_)) + _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_tl_)) + (T_Declaration_vOut28 _hdIdecls _hdIpatBindNr _hdIself) = inv_Declaration_s29 _hdX29 (T_Declaration_vIn28 _hdOdictionaryEnv _hdOimportEnv _hdOisTopLevel _hdOpatBindNr) + (T_Declarations_vOut31 _tlIdecls _tlIpatBindNr _tlIself) = inv_Declarations_s32 _tlX32 (T_Declarations_vIn31 _tlOdictionaryEnv _tlOimportEnv _tlOisTopLevel _tlOpatBindNr) + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule135 _hdIdecls _tlIdecls + _self = rule136 _hdIself _tlIself + _lhsOself :: Declarations + _lhsOself = rule137 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule138 _tlIpatBindNr + _hdOdictionaryEnv = rule139 _lhsIdictionaryEnv + _hdOimportEnv = rule140 _lhsIimportEnv + _hdOisTopLevel = rule141 _lhsIisTopLevel + _hdOpatBindNr = rule142 _lhsIpatBindNr + _tlOdictionaryEnv = rule143 _lhsIdictionaryEnv + _tlOimportEnv = rule144 _lhsIimportEnv + _tlOisTopLevel = rule145 _lhsIisTopLevel + _tlOpatBindNr = rule146 _hdIpatBindNr + __result_ = T_Declarations_vOut31 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule135 #-} + rule135 = \ ((_hdIdecls) :: [CoreDecl] ) ((_tlIdecls) :: [CoreDecl] ) -> + _hdIdecls ++ _tlIdecls + {-# INLINE rule136 #-} + rule136 = \ ((_hdIself) :: Declaration) ((_tlIself) :: Declarations) -> + (:) _hdIself _tlIself + {-# INLINE rule137 #-} + rule137 = \ _self -> + _self + {-# INLINE rule138 #-} + rule138 = \ ((_tlIpatBindNr) :: Int) -> + _tlIpatBindNr + {-# INLINE rule139 #-} + rule139 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule140 #-} + rule140 = \ ((_lhsIimportEnv) :: ImportEnvironment) -> + _lhsIimportEnv + {-# INLINE rule141 #-} + rule141 = \ ((_lhsIisTopLevel) :: Bool) -> + _lhsIisTopLevel + {-# INLINE rule142 #-} + rule142 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr + {-# INLINE rule143 #-} + rule143 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule144 #-} + rule144 = \ ((_lhsIimportEnv) :: ImportEnvironment) -> + _lhsIimportEnv + {-# INLINE rule145 #-} + rule145 = \ ((_lhsIisTopLevel) :: Bool) -> + _lhsIisTopLevel + {-# INLINE rule146 #-} + rule146 = \ ((_hdIpatBindNr) :: Int) -> + _hdIpatBindNr +{-# NOINLINE sem_Declarations_Nil #-} +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 _lhsIdictionaryEnv _lhsIimportEnv _lhsIisTopLevel _lhsIpatBindNr) -> ( let + _lhsOdecls :: [CoreDecl] + _lhsOdecls = rule147 () + _self = rule148 () + _lhsOself :: Declarations + _lhsOself = rule149 _self + _lhsOpatBindNr :: Int + _lhsOpatBindNr = rule150 _lhsIpatBindNr + __result_ = T_Declarations_vOut31 _lhsOdecls _lhsOpatBindNr _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule147 #-} + rule147 = \ (_ :: ()) -> + [] + {-# INLINE rule148 #-} + rule148 = \ (_ :: ()) -> + [] + {-# INLINE rule149 #-} + rule149 = \ _self -> + _self + {-# INLINE rule150 #-} + rule150 = \ ((_lhsIpatBindNr) :: Int) -> + _lhsIpatBindNr + +-- Export ------------------------------------------------------ +-- wrapper +data Inh_Export = Inh_Export { } +data Syn_Export = Syn_Export { cons_Syn_Export :: (IdSet), mods_Syn_Export :: (IdSet), self_Syn_Export :: (Export), types_Syn_Export :: (IdSet), values_Syn_Export :: (IdSet) } +{-# INLINABLE wrap_Export #-} +wrap_Export :: T_Export -> Inh_Export -> (Syn_Export ) +wrap_Export (T_Export act) (Inh_Export ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Export_vIn34 + (T_Export_vOut34 _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues) <- return (inv_Export_s35 sem arg) + return (Syn_Export _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues) + ) + +-- cata +{-# NOINLINE sem_Export #-} +sem_Export :: Export -> T_Export +sem_Export ( Export_Variable range_ name_ ) = sem_Export_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_TypeOrClass range_ name_ names_ ) = sem_Export_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Export ( Export_TypeOrClassComplete range_ name_ ) = sem_Export_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_Module range_ name_ ) = sem_Export_Module ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Export = T_Export { + attach_T_Export :: Identity (T_Export_s35 ) + } +newtype T_Export_s35 = C_Export_s35 { + inv_Export_s35 :: (T_Export_v34 ) + } +data T_Export_s36 = C_Export_s36 +type T_Export_v34 = (T_Export_vIn34 ) -> (T_Export_vOut34 ) +data T_Export_vIn34 = T_Export_vIn34 +data T_Export_vOut34 = T_Export_vOut34 (IdSet) (IdSet) (Export) (IdSet) (IdSet) +{-# NOINLINE sem_Export_Variable #-} +sem_Export_Variable :: T_Range -> T_Name -> T_Export +sem_Export_Variable arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOvalues :: IdSet + _lhsOvalues = rule151 _nameIself + _lhsOtypes :: IdSet + _lhsOtypes = rule152 () + _lhsOcons :: IdSet + _lhsOcons = rule153 () + _lhsOmods :: IdSet + _lhsOmods = rule154 () + _self = rule155 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule156 _self + __result_ = T_Export_vOut34 _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule151 #-} + rule151 = \ ((_nameIself) :: Name) -> + singleSet (idFromName _nameIself) + {-# INLINE rule152 #-} + rule152 = \ (_ :: ()) -> + emptySet + {-# INLINE rule153 #-} + rule153 = \ (_ :: ()) -> + emptySet + {-# INLINE rule154 #-} + rule154 = \ (_ :: ()) -> + emptySet + {-# INLINE rule155 #-} + rule155 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Variable _rangeIself _nameIself + {-# INLINE rule156 #-} + rule156 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClass #-} +sem_Export_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Export +sem_Export_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesInames _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _lhsOvalues :: IdSet + _lhsOvalues = rule157 () + _lhsOtypes :: IdSet + _lhsOtypes = rule158 _nameIself + _lhsOcons :: IdSet + _lhsOcons = rule159 _namesInames + _lhsOmods :: IdSet + _lhsOmods = rule160 () + _self = rule161 _nameIself _namesIself _rangeIself + _lhsOself :: Export + _lhsOself = rule162 _self + __result_ = T_Export_vOut34 _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule157 #-} + rule157 = \ (_ :: ()) -> + emptySet + {-# INLINE rule158 #-} + rule158 = \ ((_nameIself) :: Name) -> + singleSet (idFromName _nameIself) + {-# INLINE rule159 #-} + rule159 = \ ((_namesInames) :: Maybe [Name] ) -> + setFromList (maybe [] (map idFromName) _namesInames) + {-# INLINE rule160 #-} + rule160 = \ (_ :: ()) -> + emptySet + {-# INLINE rule161 #-} + rule161 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Export_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule162 #-} + rule162 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClassComplete #-} +sem_Export_TypeOrClassComplete :: T_Range -> T_Name -> T_Export +sem_Export_TypeOrClassComplete arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOvalues :: IdSet + _lhsOvalues = rule163 () + _lhsOtypes :: IdSet + _lhsOtypes = rule164 () + _lhsOcons :: IdSet + _lhsOcons = rule165 () + _lhsOmods :: IdSet + _lhsOmods = rule166 () + _self = rule167 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule168 _self + __result_ = T_Export_vOut34 _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule163 #-} + rule163 = \ (_ :: ()) -> + internalError "ToCoreModule" "exports.tocc" "Unsupported export declaration" + {-# INLINE rule164 #-} + rule164 = \ (_ :: ()) -> + internalError "ToCoreModule" "exports.tocc" "Unsupported export declaration" + {-# INLINE rule165 #-} + rule165 = \ (_ :: ()) -> + internalError "ToCoreModule" "exports.tocc" "Unsupported export declaration" + {-# INLINE rule166 #-} + rule166 = \ (_ :: ()) -> + internalError "ToCoreModule" "exports.tocc" "Unsupported export declaration" + {-# INLINE rule167 #-} + rule167 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule168 #-} + rule168 = \ _self -> + _self +{-# NOINLINE sem_Export_Module #-} +sem_Export_Module :: T_Range -> T_Name -> T_Export +sem_Export_Module arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOvalues :: IdSet + _lhsOvalues = rule169 () + _lhsOtypes :: IdSet + _lhsOtypes = rule170 () + _lhsOcons :: IdSet + _lhsOcons = rule171 () + _lhsOmods :: IdSet + _lhsOmods = rule172 _nameIself + _self = rule173 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule174 _self + __result_ = T_Export_vOut34 _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule169 #-} + rule169 = \ (_ :: ()) -> + emptySet + {-# INLINE rule170 #-} + rule170 = \ (_ :: ()) -> + emptySet + {-# INLINE rule171 #-} + rule171 = \ (_ :: ()) -> + emptySet + {-# INLINE rule172 #-} + rule172 = \ ((_nameIself) :: Name) -> + singleSet (idFromName _nameIself) + {-# INLINE rule173 #-} + rule173 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Module _rangeIself _nameIself + {-# INLINE rule174 #-} + rule174 = \ _self -> + _self + +-- Exports ----------------------------------------------------- +-- wrapper +data Inh_Exports = Inh_Exports { } +data Syn_Exports = Syn_Exports { cons_Syn_Exports :: (IdSet), mods_Syn_Exports :: (IdSet), self_Syn_Exports :: (Exports), types_Syn_Exports :: (IdSet), values_Syn_Exports :: (IdSet) } +{-# INLINABLE wrap_Exports #-} +wrap_Exports :: T_Exports -> Inh_Exports -> (Syn_Exports ) +wrap_Exports (T_Exports act) (Inh_Exports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Exports_vIn37 + (T_Exports_vOut37 _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues) <- return (inv_Exports_s38 sem arg) + return (Syn_Exports _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues) + ) + +-- cata +{-# NOINLINE sem_Exports #-} +sem_Exports :: Exports -> T_Exports +sem_Exports list = Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list) + +-- semantic domain +newtype T_Exports = T_Exports { + attach_T_Exports :: Identity (T_Exports_s38 ) + } +newtype T_Exports_s38 = C_Exports_s38 { + inv_Exports_s38 :: (T_Exports_v37 ) + } +data T_Exports_s39 = C_Exports_s39 +type T_Exports_v37 = (T_Exports_vIn37 ) -> (T_Exports_vOut37 ) +data T_Exports_vIn37 = T_Exports_vIn37 +data T_Exports_vOut37 = T_Exports_vOut37 (IdSet) (IdSet) (Exports) (IdSet) (IdSet) +{-# NOINLINE sem_Exports_Cons #-} +sem_Exports_Cons :: T_Export -> T_Exports -> T_Exports +sem_Exports_Cons arg_hd_ arg_tl_ = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Export (arg_hd_)) + _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_tl_)) + (T_Export_vOut34 _hdIcons _hdImods _hdIself _hdItypes _hdIvalues) = inv_Export_s35 _hdX35 (T_Export_vIn34 ) + (T_Exports_vOut37 _tlIcons _tlImods _tlIself _tlItypes _tlIvalues) = inv_Exports_s38 _tlX38 (T_Exports_vIn37 ) + _lhsOcons :: IdSet + _lhsOcons = rule175 _hdIcons _tlIcons + _lhsOmods :: IdSet + _lhsOmods = rule176 _hdImods _tlImods + _lhsOtypes :: IdSet + _lhsOtypes = rule177 _hdItypes _tlItypes + _lhsOvalues :: IdSet + _lhsOvalues = rule178 _hdIvalues _tlIvalues + _self = rule179 _hdIself _tlIself + _lhsOself :: Exports + _lhsOself = rule180 _self + __result_ = T_Exports_vOut37 _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule175 #-} + rule175 = \ ((_hdIcons) :: IdSet) ((_tlIcons) :: IdSet) -> + _hdIcons `unionSet` _tlIcons + {-# INLINE rule176 #-} + rule176 = \ ((_hdImods) :: IdSet) ((_tlImods) :: IdSet) -> + _hdImods `unionSet` _tlImods + {-# INLINE rule177 #-} + rule177 = \ ((_hdItypes) :: IdSet) ((_tlItypes) :: IdSet) -> + _hdItypes `unionSet` _tlItypes + {-# INLINE rule178 #-} + rule178 = \ ((_hdIvalues) :: IdSet) ((_tlIvalues) :: IdSet) -> + _hdIvalues `unionSet` _tlIvalues + {-# INLINE rule179 #-} + rule179 = \ ((_hdIself) :: Export) ((_tlIself) :: Exports) -> + (:) _hdIself _tlIself + {-# INLINE rule180 #-} + rule180 = \ _self -> + _self +{-# NOINLINE sem_Exports_Nil #-} +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _lhsOcons :: IdSet + _lhsOcons = rule181 () + _lhsOmods :: IdSet + _lhsOmods = rule182 () + _lhsOtypes :: IdSet + _lhsOtypes = rule183 () + _lhsOvalues :: IdSet + _lhsOvalues = rule184 () + _self = rule185 () + _lhsOself :: Exports + _lhsOself = rule186 _self + __result_ = T_Exports_vOut37 _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule181 #-} + rule181 = \ (_ :: ()) -> + emptySet + {-# INLINE rule182 #-} + rule182 = \ (_ :: ()) -> + emptySet + {-# INLINE rule183 #-} + rule183 = \ (_ :: ()) -> + emptySet + {-# INLINE rule184 #-} + rule184 = \ (_ :: ()) -> + emptySet + {-# INLINE rule185 #-} + rule185 = \ (_ :: ()) -> + [] + {-# INLINE rule186 #-} + rule186 = \ _self -> + _self + +-- Expression -------------------------------------------------- +-- wrapper +data Inh_Expression = Inh_Expression { dictionaryEnv_Inh_Expression :: (DictionaryEnvironment) } +data Syn_Expression = Syn_Expression { core_Syn_Expression :: ( Core.Expr ), self_Syn_Expression :: (Expression) } +{-# INLINABLE wrap_Expression #-} +wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) +wrap_Expression (T_Expression act) (Inh_Expression _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expression_vIn40 _lhsIdictionaryEnv + (T_Expression_vOut40 _lhsOcore _lhsOself) <- return (inv_Expression_s41 sem arg) + return (Syn_Expression _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expression #-} +sem_Expression :: Expression -> T_Expression +sem_Expression ( Expression_Hole range_ id_ ) = sem_Expression_Hole ( sem_Range range_ ) id_ +sem_Expression ( Expression_Feedback range_ feedback_ expression_ ) = sem_Expression_Feedback ( sem_Range range_ ) feedback_ ( sem_Expression expression_ ) +sem_Expression ( Expression_MustUse range_ expression_ ) = sem_Expression_MustUse ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Literal range_ literal_ ) = sem_Expression_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Expression ( Expression_Variable range_ name_ ) = sem_Expression_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Constructor range_ name_ ) = sem_Expression_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Parenthesized range_ expression_ ) = sem_Expression_Parenthesized ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NormalApplication range_ function_ arguments_ ) = sem_Expression_NormalApplication ( sem_Range range_ ) ( sem_Expression function_ ) ( sem_Expressions arguments_ ) +sem_Expression ( Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ ) = sem_Expression_InfixApplication ( sem_Range range_ ) ( sem_MaybeExpression leftExpression_ ) ( sem_Expression operator_ ) ( sem_MaybeExpression rightExpression_ ) +sem_Expression ( Expression_If range_ guardExpression_ thenExpression_ elseExpression_ ) = sem_Expression_If ( sem_Range range_ ) ( sem_Expression guardExpression_ ) ( sem_Expression thenExpression_ ) ( sem_Expression elseExpression_ ) +sem_Expression ( Expression_Lambda range_ patterns_ expression_ ) = sem_Expression_Lambda ( sem_Range range_ ) ( sem_Patterns patterns_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Case range_ expression_ alternatives_ ) = sem_Expression_Case ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Alternatives alternatives_ ) +sem_Expression ( Expression_Let range_ declarations_ expression_ ) = sem_Expression_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Do range_ statements_ ) = sem_Expression_Do ( sem_Range range_ ) ( sem_Statements statements_ ) +sem_Expression ( Expression_List range_ expressions_ ) = sem_Expression_List ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Tuple range_ expressions_ ) = sem_Expression_Tuple ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Comprehension range_ expression_ qualifiers_ ) = sem_Expression_Comprehension ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Qualifiers qualifiers_ ) +sem_Expression ( Expression_Typed range_ expression_ type_ ) = sem_Expression_Typed ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Type type_ ) +sem_Expression ( Expression_RecordConstruction range_ name_ recordExpressionBindings_ ) = sem_Expression_RecordConstruction ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_RecordUpdate range_ expression_ recordExpressionBindings_ ) = sem_Expression_RecordUpdate ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_Enum range_ from_ then_ to_ ) = sem_Expression_Enum ( sem_Range range_ ) ( sem_Expression from_ ) ( sem_MaybeExpression then_ ) ( sem_MaybeExpression to_ ) +sem_Expression ( Expression_Negate range_ expression_ ) = sem_Expression_Negate ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NegateFloat range_ expression_ ) = sem_Expression_NegateFloat ( sem_Range range_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_Expression = T_Expression { + attach_T_Expression :: Identity (T_Expression_s41 ) + } +newtype T_Expression_s41 = C_Expression_s41 { + inv_Expression_s41 :: (T_Expression_v40 ) + } +data T_Expression_s42 = C_Expression_s42 +type T_Expression_v40 = (T_Expression_vIn40 ) -> (T_Expression_vOut40 ) +data T_Expression_vIn40 = T_Expression_vIn40 (DictionaryEnvironment) +data T_Expression_vOut40 = T_Expression_vOut40 ( Core.Expr ) (Expression) +{-# NOINLINE sem_Expression_Hole #-} +sem_Expression_Hole :: T_Range -> (Integer) -> T_Expression +sem_Expression_Hole arg_range_ arg_id_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcore :: Core.Expr + _lhsOcore = rule187 () + _self = rule188 _rangeIself arg_id_ + _lhsOself :: Expression + _lhsOself = rule189 _self + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule187 #-} + rule187 = \ (_ :: ()) -> + Core.Var (idFromString "undefined") + {-# INLINE rule188 #-} + rule188 = \ ((_rangeIself) :: Range) id_ -> + Expression_Hole _rangeIself id_ + {-# INLINE rule189 #-} + rule189 = \ _self -> + _self +{-# NOINLINE sem_Expression_Feedback #-} +sem_Expression_Feedback :: T_Range -> (String) -> T_Expression -> T_Expression +sem_Expression_Feedback arg_range_ arg_feedback_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _self = rule190 _expressionIself _rangeIself arg_feedback_ + _lhsOself :: Expression + _lhsOself = rule191 _self + _lhsOcore :: Core.Expr + _lhsOcore = rule192 _expressionIcore + _expressionOdictionaryEnv = rule193 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule190 #-} + rule190 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) feedback_ -> + Expression_Feedback _rangeIself feedback_ _expressionIself + {-# INLINE rule191 #-} + rule191 = \ _self -> + _self + {-# INLINE rule192 #-} + rule192 = \ ((_expressionIcore) :: Core.Expr ) -> + _expressionIcore + {-# INLINE rule193 #-} + rule193 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_MustUse #-} +sem_Expression_MustUse :: T_Range -> T_Expression -> T_Expression +sem_Expression_MustUse arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _self = rule194 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule195 _self + _lhsOcore :: Core.Expr + _lhsOcore = rule196 _expressionIcore + _expressionOdictionaryEnv = rule197 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule194 #-} + rule194 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_MustUse _rangeIself _expressionIself + {-# INLINE rule195 #-} + rule195 = \ _self -> + _self + {-# INLINE rule196 #-} + rule196 = \ ((_expressionIcore) :: Core.Expr ) -> + _expressionIcore + {-# INLINE rule197 #-} + rule197 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_Literal #-} +sem_Expression_Literal :: T_Range -> T_Literal -> T_Expression +sem_Expression_Literal arg_range_ arg_literal_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIcore _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _lhsOcore :: Core.Expr + _lhsOcore = rule198 _literalIcore + _self = rule199 _literalIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule200 _self + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule198 #-} + rule198 = \ ((_literalIcore) :: Core.Expr ) -> + _literalIcore + {-# INLINE rule199 #-} + rule199 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Expression_Literal _rangeIself _literalIself + {-# INLINE rule200 #-} + rule200 = \ _self -> + _self +{-# NOINLINE sem_Expression_Variable #-} +sem_Expression_Variable :: T_Range -> T_Name -> T_Expression +sem_Expression_Variable arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOcore :: Core.Expr + _lhsOcore = rule201 _lhsIdictionaryEnv _nameIself + _self = rule202 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule203 _self + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule201 #-} + rule201 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) ((_nameIself) :: Name) -> + insertDictionaries _nameIself _lhsIdictionaryEnv + {-# INLINE rule202 #-} + rule202 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Variable _rangeIself _nameIself + {-# INLINE rule203 #-} + rule203 = \ _self -> + _self +{-# NOINLINE sem_Expression_Constructor #-} +sem_Expression_Constructor :: T_Range -> T_Name -> T_Expression +sem_Expression_Constructor arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOcore :: Core.Expr + _lhsOcore = rule204 _nameIself + _self = rule205 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule206 _self + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule204 #-} + rule204 = \ ((_nameIself) :: Name) -> + Core.Con (Core.ConId (idFromName _nameIself)) + {-# INLINE rule205 #-} + rule205 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Constructor _rangeIself _nameIself + {-# INLINE rule206 #-} + rule206 = \ _self -> + _self +{-# NOINLINE sem_Expression_Parenthesized #-} +sem_Expression_Parenthesized :: T_Range -> T_Expression -> T_Expression +sem_Expression_Parenthesized arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule207 _expressionIcore + _self = rule208 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule209 _self + _expressionOdictionaryEnv = rule210 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule207 #-} + rule207 = \ ((_expressionIcore) :: Core.Expr ) -> + _expressionIcore + {-# INLINE rule208 #-} + rule208 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Parenthesized _rangeIself _expressionIself + {-# INLINE rule209 #-} + rule209 = \ _self -> + _self + {-# INLINE rule210 #-} + rule210 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_NormalApplication #-} +sem_Expression_NormalApplication :: T_Range -> T_Expression -> T_Expressions -> T_Expression +sem_Expression_NormalApplication arg_range_ arg_function_ arg_arguments_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_function_)) + _argumentsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _functionIcore _functionIself) = inv_Expression_s41 _functionX41 (T_Expression_vIn40 _functionOdictionaryEnv) + (T_Expressions_vOut43 _argumentsIcore _argumentsIself) = inv_Expressions_s44 _argumentsX44 (T_Expressions_vIn43 _argumentsOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule211 _argumentsIcore _functionIcore + _self = rule212 _argumentsIself _functionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule213 _self + _functionOdictionaryEnv = rule214 _lhsIdictionaryEnv + _argumentsOdictionaryEnv = rule215 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule211 #-} + rule211 = \ ((_argumentsIcore) :: [Core.Expr] ) ((_functionIcore) :: Core.Expr ) -> + foldl Core.Ap _functionIcore _argumentsIcore + {-# INLINE rule212 #-} + rule212 = \ ((_argumentsIself) :: Expressions) ((_functionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NormalApplication _rangeIself _functionIself _argumentsIself + {-# INLINE rule213 #-} + rule213 = \ _self -> + _self + {-# INLINE rule214 #-} + rule214 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule215 #-} + rule215 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_InfixApplication #-} +sem_Expression_InfixApplication :: T_Range -> T_MaybeExpression -> T_Expression -> T_MaybeExpression -> T_Expression +sem_Expression_InfixApplication arg_range_ arg_leftExpression_ arg_operator_ arg_rightExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_leftExpression_)) + _operatorX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_operator_)) + _rightExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_rightExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeExpression_vOut94 _leftExpressionIcore _leftExpressionIself) = inv_MaybeExpression_s95 _leftExpressionX95 (T_MaybeExpression_vIn94 _leftExpressionOdictionaryEnv) + (T_Expression_vOut40 _operatorIcore _operatorIself) = inv_Expression_s41 _operatorX41 (T_Expression_vIn40 _operatorOdictionaryEnv) + (T_MaybeExpression_vOut94 _rightExpressionIcore _rightExpressionIself) = inv_MaybeExpression_s95 _rightExpressionX95 (T_MaybeExpression_vIn94 _rightExpressionOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule216 _leftExpressionIcore _operatorIcore _rightExpressionIcore + _self = rule217 _leftExpressionIself _operatorIself _rangeIself _rightExpressionIself + _lhsOself :: Expression + _lhsOself = rule218 _self + _leftExpressionOdictionaryEnv = rule219 _lhsIdictionaryEnv + _operatorOdictionaryEnv = rule220 _lhsIdictionaryEnv + _rightExpressionOdictionaryEnv = rule221 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule216 #-} + rule216 = \ ((_leftExpressionIcore) :: Maybe Core.Expr ) ((_operatorIcore) :: Core.Expr ) ((_rightExpressionIcore) :: Maybe Core.Expr ) -> + case (_leftExpressionIcore, _rightExpressionIcore) of + (Nothing, Nothing) -> _operatorIcore + (Just l , Nothing) -> Core.Ap _operatorIcore l + (Nothing, Just r ) -> Core.Lam parameterId + (foldl Core.Ap _operatorIcore [Core.Var parameterId, r]) + (Just l , Just r ) -> foldl Core.Ap _operatorIcore [l,r] + {-# INLINE rule217 #-} + rule217 = \ ((_leftExpressionIself) :: MaybeExpression) ((_operatorIself) :: Expression) ((_rangeIself) :: Range) ((_rightExpressionIself) :: MaybeExpression) -> + Expression_InfixApplication _rangeIself _leftExpressionIself _operatorIself _rightExpressionIself + {-# INLINE rule218 #-} + rule218 = \ _self -> + _self + {-# INLINE rule219 #-} + rule219 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule220 #-} + rule220 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule221 #-} + rule221 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_If #-} +sem_Expression_If :: T_Range -> T_Expression -> T_Expression -> T_Expression -> T_Expression +sem_Expression_If arg_range_ arg_guardExpression_ arg_thenExpression_ arg_elseExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guardExpression_)) + _thenExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_thenExpression_)) + _elseExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_elseExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardExpressionIcore _guardExpressionIself) = inv_Expression_s41 _guardExpressionX41 (T_Expression_vIn40 _guardExpressionOdictionaryEnv) + (T_Expression_vOut40 _thenExpressionIcore _thenExpressionIself) = inv_Expression_s41 _thenExpressionX41 (T_Expression_vIn40 _thenExpressionOdictionaryEnv) + (T_Expression_vOut40 _elseExpressionIcore _elseExpressionIself) = inv_Expression_s41 _elseExpressionX41 (T_Expression_vIn40 _elseExpressionOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule222 _elseExpressionIcore _guardExpressionIcore _thenExpressionIcore + _self = rule223 _elseExpressionIself _guardExpressionIself _rangeIself _thenExpressionIself + _lhsOself :: Expression + _lhsOself = rule224 _self + _guardExpressionOdictionaryEnv = rule225 _lhsIdictionaryEnv + _thenExpressionOdictionaryEnv = rule226 _lhsIdictionaryEnv + _elseExpressionOdictionaryEnv = rule227 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule222 #-} + rule222 = \ ((_elseExpressionIcore) :: Core.Expr ) ((_guardExpressionIcore) :: Core.Expr ) ((_thenExpressionIcore) :: Core.Expr ) -> + if_ _guardExpressionIcore _thenExpressionIcore _elseExpressionIcore + {-# INLINE rule223 #-} + rule223 = \ ((_elseExpressionIself) :: Expression) ((_guardExpressionIself) :: Expression) ((_rangeIself) :: Range) ((_thenExpressionIself) :: Expression) -> + Expression_If _rangeIself _guardExpressionIself _thenExpressionIself _elseExpressionIself + {-# INLINE rule224 #-} + rule224 = \ _self -> + _self + {-# INLINE rule225 #-} + rule225 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule226 #-} + rule226 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule227 #-} + rule227 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_Lambda #-} +sem_Expression_Lambda :: T_Range -> T_Patterns -> T_Expression -> T_Expression +sem_Expression_Lambda arg_range_ arg_patterns_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIlength _patternsIself _patternsIvars) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule228 _expressionIcore _patternsIlength _patternsIself _rangeIself + _self = rule229 _expressionIself _patternsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule230 _self + _expressionOdictionaryEnv = rule231 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule228 #-} + rule228 = \ ((_expressionIcore) :: Core.Expr ) ((_patternsIlength) :: Int) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + let ids = freshIds "u$" _patternsIlength + in let_ nextClauseId (patternMatchFail "lambda expression" _rangeIself) + (foldr + Core.Lam + (patternsToCore + (zip ids _patternsIself) + _expressionIcore + ) + ids + ) + {-# INLINE rule229 #-} + rule229 = \ ((_expressionIself) :: Expression) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Expression_Lambda _rangeIself _patternsIself _expressionIself + {-# INLINE rule230 #-} + rule230 = \ _self -> + _self + {-# INLINE rule231 #-} + rule231 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_Case #-} +sem_Expression_Case :: T_Range -> T_Expression -> T_Alternatives -> T_Expression +sem_Expression_Case arg_range_ arg_expression_ arg_alternatives_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _alternativesX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_alternatives_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + (T_Alternatives_vOut4 _alternativesIcore _alternativesIself) = inv_Alternatives_s5 _alternativesX5 (T_Alternatives_vIn4 _alternativesOcaseRange _alternativesOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule232 _alternativesIcore _expressionIcore + _alternativesOcaseRange = rule233 _rangeIself + _self = rule234 _alternativesIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule235 _self + _expressionOdictionaryEnv = rule236 _lhsIdictionaryEnv + _alternativesOdictionaryEnv = rule237 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule232 #-} + rule232 = \ ((_alternativesIcore) :: Core.Expr ) ((_expressionIcore) :: Core.Expr ) -> + let_ caseExprId _expressionIcore _alternativesIcore + {-# INLINE rule233 #-} + rule233 = \ ((_rangeIself) :: Range) -> + _rangeIself + {-# INLINE rule234 #-} + rule234 = \ ((_alternativesIself) :: Alternatives) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Case _rangeIself _expressionIself _alternativesIself + {-# INLINE rule235 #-} + rule235 = \ _self -> + _self + {-# INLINE rule236 #-} + rule236 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule237 #-} + rule237 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_Let #-} +sem_Expression_Let :: T_Range -> T_Declarations -> T_Expression -> T_Expression +sem_Expression_Let arg_range_ arg_declarations_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIdecls _declarationsIpatBindNr _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOdictionaryEnv _declarationsOimportEnv _declarationsOisTopLevel _declarationsOpatBindNr) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _importEnv = rule238 () + _declarationsOpatBindNr = rule239 () + _declarationsOisTopLevel = rule240 () + _lhsOcore :: Core.Expr + _lhsOcore = rule241 _declarationsIdecls _expressionIcore + _self = rule242 _declarationsIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule243 _self + _declarationsOdictionaryEnv = rule244 _lhsIdictionaryEnv + _declarationsOimportEnv = rule245 _importEnv + _expressionOdictionaryEnv = rule246 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule238 #-} + rule238 = \ (_ :: ()) -> + internalError "CodeGeneration.ag" "Expression.Let" "" + {-# INLINE rule239 #-} + rule239 = \ (_ :: ()) -> + 0 + {-# INLINE rule240 #-} + rule240 = \ (_ :: ()) -> + False + {-# INLINE rule241 #-} + rule241 = \ ((_declarationsIdecls) :: [CoreDecl] ) ((_expressionIcore) :: Core.Expr ) -> + letrec_ _declarationsIdecls _expressionIcore + {-# INLINE rule242 #-} + rule242 = \ ((_declarationsIself) :: Declarations) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Let _rangeIself _declarationsIself _expressionIself + {-# INLINE rule243 #-} + rule243 = \ _self -> + _self + {-# INLINE rule244 #-} + rule244 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule245 #-} + rule245 = \ _importEnv -> + _importEnv + {-# INLINE rule246 #-} + rule246 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_Do #-} +sem_Expression_Do :: T_Range -> T_Statements -> T_Expression +sem_Expression_Do arg_range_ arg_statements_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _statementsX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_statements_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Statements_vOut157 _statementsIcore _statementsIself) = inv_Statements_s158 _statementsX158 (T_Statements_vIn157 _statementsOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule247 _statementsIcore + _self = rule248 _rangeIself _statementsIself + _lhsOself :: Expression + _lhsOself = rule249 _self + _statementsOdictionaryEnv = rule250 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule247 #-} + rule247 = \ ((_statementsIcore) :: [Maybe Core.Expr -> Core.Expr] ) -> + chainCode _statementsIcore + {-# INLINE rule248 #-} + rule248 = \ ((_rangeIself) :: Range) ((_statementsIself) :: Statements) -> + Expression_Do _rangeIself _statementsIself + {-# INLINE rule249 #-} + rule249 = \ _self -> + _self + {-# INLINE rule250 #-} + rule250 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_List #-} +sem_Expression_List :: T_Range -> T_Expressions -> T_Expression +sem_Expression_List arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIcore _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 _expressionsOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule251 _expressionsIcore + _self = rule252 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule253 _self + _expressionsOdictionaryEnv = rule254 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule251 #-} + rule251 = \ ((_expressionsIcore) :: [Core.Expr] ) -> + coreList _expressionsIcore + {-# INLINE rule252 #-} + rule252 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_List _rangeIself _expressionsIself + {-# INLINE rule253 #-} + rule253 = \ _self -> + _self + {-# INLINE rule254 #-} + rule254 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_Tuple #-} +sem_Expression_Tuple :: T_Range -> T_Expressions -> T_Expression +sem_Expression_Tuple arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIcore _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 _expressionsOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule255 _expressionsIcore + _self = rule256 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule257 _self + _expressionsOdictionaryEnv = rule258 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule255 #-} + rule255 = \ ((_expressionsIcore) :: [Core.Expr] ) -> + foldl + Core.Ap + (Core.Con + (Core.ConTag + (Core.Lit (Core.LitInt 0)) + (length _expressionsIcore) + ) + ) + _expressionsIcore + {-# INLINE rule256 #-} + rule256 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_Tuple _rangeIself _expressionsIself + {-# INLINE rule257 #-} + rule257 = \ _self -> + _self + {-# INLINE rule258 #-} + rule258 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_Comprehension #-} +sem_Expression_Comprehension :: T_Range -> T_Expression -> T_Qualifiers -> T_Expression +sem_Expression_Comprehension arg_range_ arg_expression_ arg_qualifiers_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _qualifiersX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_qualifiers_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + (T_Qualifiers_vOut130 _qualifiersIcore _qualifiersIself) = inv_Qualifiers_s131 _qualifiersX131 (T_Qualifiers_vIn130 _qualifiersOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule259 _expressionIcore _qualifiersIcore + _self = rule260 _expressionIself _qualifiersIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule261 _self + _expressionOdictionaryEnv = rule262 _lhsIdictionaryEnv + _qualifiersOdictionaryEnv = rule263 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule259 #-} + rule259 = \ ((_expressionIcore) :: Core.Expr ) ((_qualifiersIcore) :: [Core.Expr -> Core.Expr] ) -> + let singleton x = cons x nil + in foldr ($) (singleton _expressionIcore) _qualifiersIcore + {-# INLINE rule260 #-} + rule260 = \ ((_expressionIself) :: Expression) ((_qualifiersIself) :: Qualifiers) ((_rangeIself) :: Range) -> + Expression_Comprehension _rangeIself _expressionIself _qualifiersIself + {-# INLINE rule261 #-} + rule261 = \ _self -> + _self + {-# INLINE rule262 #-} + rule262 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule263 #-} + rule263 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_Typed #-} +sem_Expression_Typed :: T_Range -> T_Expression -> T_Type -> T_Expression +sem_Expression_Typed arg_range_ arg_expression_ arg_type_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _lhsOcore :: Core.Expr + _lhsOcore = rule264 _expressionIcore + _self = rule265 _expressionIself _rangeIself _typeIself + _lhsOself :: Expression + _lhsOself = rule266 _self + _expressionOdictionaryEnv = rule267 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule264 #-} + rule264 = \ ((_expressionIcore) :: Core.Expr ) -> + _expressionIcore + {-# INLINE rule265 #-} + rule265 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Expression_Typed _rangeIself _expressionIself _typeIself + {-# INLINE rule266 #-} + rule266 = \ _self -> + _self + {-# INLINE rule267 #-} + rule267 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_RecordConstruction #-} +sem_Expression_RecordConstruction :: T_Range -> T_Name -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordConstruction arg_range_ arg_name_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 _recordExpressionBindingsOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule268 () + _self = rule269 _nameIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule270 _self + _recordExpressionBindingsOdictionaryEnv = rule271 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule268 #-} + rule268 = \ (_ :: ()) -> + internalError "ToCoreExpr" "Expression" "records not supported" + {-# INLINE rule269 #-} + rule269 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordConstruction _rangeIself _nameIself _recordExpressionBindingsIself + {-# INLINE rule270 #-} + rule270 = \ _self -> + _self + {-# INLINE rule271 #-} + rule271 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_RecordUpdate #-} +sem_Expression_RecordUpdate :: T_Range -> T_Expression -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordUpdate arg_range_ arg_expression_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 _recordExpressionBindingsOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule272 () + _self = rule273 _expressionIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule274 _self + _expressionOdictionaryEnv = rule275 _lhsIdictionaryEnv + _recordExpressionBindingsOdictionaryEnv = rule276 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule272 #-} + rule272 = \ (_ :: ()) -> + internalError "ToCoreExpr" "Expression" "records not supported" + {-# INLINE rule273 #-} + rule273 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordUpdate _rangeIself _expressionIself _recordExpressionBindingsIself + {-# INLINE rule274 #-} + rule274 = \ _self -> + _self + {-# INLINE rule275 #-} + rule275 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule276 #-} + rule276 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_Enum #-} +sem_Expression_Enum :: T_Range -> T_Expression -> T_MaybeExpression -> T_MaybeExpression -> T_Expression +sem_Expression_Enum arg_range_ arg_from_ arg_then_ arg_to_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fromX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_from_)) + _thenX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_then_)) + _toX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_to_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _fromIcore _fromIself) = inv_Expression_s41 _fromX41 (T_Expression_vIn40 _fromOdictionaryEnv) + (T_MaybeExpression_vOut94 _thenIcore _thenIself) = inv_MaybeExpression_s95 _thenX95 (T_MaybeExpression_vIn94 _thenOdictionaryEnv) + (T_MaybeExpression_vOut94 _toIcore _toIself) = inv_MaybeExpression_s95 _toX95 (T_MaybeExpression_vIn94 _toOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule277 _fromIcore _lhsIdictionaryEnv _rangeIself _thenIcore _toIcore + _self = rule278 _fromIself _rangeIself _thenIself _toIself + _lhsOself :: Expression + _lhsOself = rule279 _self + _fromOdictionaryEnv = rule280 _lhsIdictionaryEnv + _thenOdictionaryEnv = rule281 _lhsIdictionaryEnv + _toOdictionaryEnv = rule282 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule277 #-} + rule277 = \ ((_fromIcore) :: Core.Expr ) ((_lhsIdictionaryEnv) :: DictionaryEnvironment) ((_rangeIself) :: Range) ((_thenIcore) :: Maybe Core.Expr ) ((_toIcore) :: Maybe Core.Expr ) -> + case (_thenIcore, _toIcore) of + (Just then_, Just to) -> + insertDictionaries (setNameRange enumFromThenToName _rangeIself) _lhsIdictionaryEnv + `app_` _fromIcore `app_` then_ `app_` to + (Just then_, Nothing) -> + insertDictionaries (setNameRange enumFromThenName _rangeIself) _lhsIdictionaryEnv + `app_` _fromIcore `app_` then_ + (Nothing, Just to) -> + insertDictionaries (setNameRange enumFromToName _rangeIself) _lhsIdictionaryEnv + `app_` _fromIcore `app_` to + (Nothing, Nothing) -> + insertDictionaries (setNameRange enumFromName _rangeIself) _lhsIdictionaryEnv + `app_` _fromIcore + {-# INLINE rule278 #-} + rule278 = \ ((_fromIself) :: Expression) ((_rangeIself) :: Range) ((_thenIself) :: MaybeExpression) ((_toIself) :: MaybeExpression) -> + Expression_Enum _rangeIself _fromIself _thenIself _toIself + {-# INLINE rule279 #-} + rule279 = \ _self -> + _self + {-# INLINE rule280 #-} + rule280 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule281 #-} + rule281 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule282 #-} + rule282 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_Negate #-} +sem_Expression_Negate :: T_Range -> T_Expression -> T_Expression +sem_Expression_Negate arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule283 _expressionIcore _lhsIdictionaryEnv _rangeIself + _self = rule284 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule285 _self + _expressionOdictionaryEnv = rule286 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule283 #-} + rule283 = \ ((_expressionIcore) :: Core.Expr ) ((_lhsIdictionaryEnv) :: DictionaryEnvironment) ((_rangeIself) :: Range) -> + insertDictionaries (setNameRange intUnaryMinusName _rangeIself) _lhsIdictionaryEnv + `app_` _expressionIcore + {-# INLINE rule284 #-} + rule284 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Negate _rangeIself _expressionIself + {-# INLINE rule285 #-} + rule285 = \ _self -> + _self + {-# INLINE rule286 #-} + rule286 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expression_NegateFloat #-} +sem_Expression_NegateFloat :: T_Range -> T_Expression -> T_Expression +sem_Expression_NegateFloat arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule287 _expressionIcore + _self = rule288 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule289 _self + _expressionOdictionaryEnv = rule290 _lhsIdictionaryEnv + __result_ = T_Expression_vOut40 _lhsOcore _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule287 #-} + rule287 = \ ((_expressionIcore) :: Core.Expr ) -> + var "$primNegFloat" `app_` _expressionIcore + {-# INLINE rule288 #-} + rule288 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NegateFloat _rangeIself _expressionIself + {-# INLINE rule289 #-} + rule289 = \ _self -> + _self + {-# INLINE rule290 #-} + rule290 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + +-- Expressions ------------------------------------------------- +-- wrapper +data Inh_Expressions = Inh_Expressions { dictionaryEnv_Inh_Expressions :: (DictionaryEnvironment) } +data Syn_Expressions = Syn_Expressions { core_Syn_Expressions :: ( [Core.Expr] ), self_Syn_Expressions :: (Expressions) } +{-# INLINABLE wrap_Expressions #-} +wrap_Expressions :: T_Expressions -> Inh_Expressions -> (Syn_Expressions ) +wrap_Expressions (T_Expressions act) (Inh_Expressions _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expressions_vIn43 _lhsIdictionaryEnv + (T_Expressions_vOut43 _lhsOcore _lhsOself) <- return (inv_Expressions_s44 sem arg) + return (Syn_Expressions _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expressions #-} +sem_Expressions :: Expressions -> T_Expressions +sem_Expressions list = Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list) + +-- semantic domain +newtype T_Expressions = T_Expressions { + attach_T_Expressions :: Identity (T_Expressions_s44 ) + } +newtype T_Expressions_s44 = C_Expressions_s44 { + inv_Expressions_s44 :: (T_Expressions_v43 ) + } +data T_Expressions_s45 = C_Expressions_s45 +type T_Expressions_v43 = (T_Expressions_vIn43 ) -> (T_Expressions_vOut43 ) +data T_Expressions_vIn43 = T_Expressions_vIn43 (DictionaryEnvironment) +data T_Expressions_vOut43 = T_Expressions_vOut43 ( [Core.Expr] ) (Expressions) +{-# NOINLINE sem_Expressions_Cons #-} +sem_Expressions_Cons :: T_Expression -> T_Expressions -> T_Expressions +sem_Expressions_Cons arg_hd_ arg_tl_ = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 _lhsIdictionaryEnv) -> ( let + _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_hd_)) + _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_tl_)) + (T_Expression_vOut40 _hdIcore _hdIself) = inv_Expression_s41 _hdX41 (T_Expression_vIn40 _hdOdictionaryEnv) + (T_Expressions_vOut43 _tlIcore _tlIself) = inv_Expressions_s44 _tlX44 (T_Expressions_vIn43 _tlOdictionaryEnv) + _lhsOcore :: [Core.Expr] + _lhsOcore = rule291 _hdIcore _tlIcore + _self = rule292 _hdIself _tlIself + _lhsOself :: Expressions + _lhsOself = rule293 _self + _hdOdictionaryEnv = rule294 _lhsIdictionaryEnv + _tlOdictionaryEnv = rule295 _lhsIdictionaryEnv + __result_ = T_Expressions_vOut43 _lhsOcore _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule291 #-} + rule291 = \ ((_hdIcore) :: Core.Expr ) ((_tlIcore) :: [Core.Expr] ) -> + _hdIcore : _tlIcore + {-# INLINE rule292 #-} + rule292 = \ ((_hdIself) :: Expression) ((_tlIself) :: Expressions) -> + (:) _hdIself _tlIself + {-# INLINE rule293 #-} + rule293 = \ _self -> + _self + {-# INLINE rule294 #-} + rule294 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule295 #-} + rule295 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Expressions_Nil #-} +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 _lhsIdictionaryEnv) -> ( let + _lhsOcore :: [Core.Expr] + _lhsOcore = rule296 () + _self = rule297 () + _lhsOself :: Expressions + _lhsOself = rule298 _self + __result_ = T_Expressions_vOut43 _lhsOcore _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule296 #-} + rule296 = \ (_ :: ()) -> + [] + {-# INLINE rule297 #-} + rule297 = \ (_ :: ()) -> + [] + {-# INLINE rule298 #-} + rule298 = \ _self -> + _self + +-- FieldDeclaration -------------------------------------------- +-- wrapper +data Inh_FieldDeclaration = Inh_FieldDeclaration { } +data Syn_FieldDeclaration = Syn_FieldDeclaration { self_Syn_FieldDeclaration :: (FieldDeclaration) } +{-# INLINABLE wrap_FieldDeclaration #-} +wrap_FieldDeclaration :: T_FieldDeclaration -> Inh_FieldDeclaration -> (Syn_FieldDeclaration ) +wrap_FieldDeclaration (T_FieldDeclaration act) (Inh_FieldDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclaration_vIn46 + (T_FieldDeclaration_vOut46 _lhsOself) <- return (inv_FieldDeclaration_s47 sem arg) + return (Syn_FieldDeclaration _lhsOself) + ) + +-- cata +{-# INLINE sem_FieldDeclaration #-} +sem_FieldDeclaration :: FieldDeclaration -> T_FieldDeclaration +sem_FieldDeclaration ( FieldDeclaration_FieldDeclaration range_ names_ type_ ) = sem_FieldDeclaration_FieldDeclaration ( sem_Range range_ ) ( sem_Names names_ ) ( sem_AnnotatedType type_ ) + +-- semantic domain +newtype T_FieldDeclaration = T_FieldDeclaration { + attach_T_FieldDeclaration :: Identity (T_FieldDeclaration_s47 ) + } +newtype T_FieldDeclaration_s47 = C_FieldDeclaration_s47 { + inv_FieldDeclaration_s47 :: (T_FieldDeclaration_v46 ) + } +data T_FieldDeclaration_s48 = C_FieldDeclaration_s48 +type T_FieldDeclaration_v46 = (T_FieldDeclaration_vIn46 ) -> (T_FieldDeclaration_vOut46 ) +data T_FieldDeclaration_vIn46 = T_FieldDeclaration_vIn46 +data T_FieldDeclaration_vOut46 = T_FieldDeclaration_vOut46 (FieldDeclaration) +{-# NOINLINE sem_FieldDeclaration_FieldDeclaration #-} +sem_FieldDeclaration_FieldDeclaration :: T_Range -> T_Names -> T_AnnotatedType -> T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration arg_range_ arg_names_ arg_type_ = T_FieldDeclaration (return st47) where + {-# NOINLINE st47 #-} + st47 = let + v46 :: T_FieldDeclaration_v46 + v46 = \ (T_FieldDeclaration_vIn46 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesInames _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_AnnotatedType_vOut7 _typeIself) = inv_AnnotatedType_s8 _typeX8 (T_AnnotatedType_vIn7 ) + _self = rule299 _namesIself _rangeIself _typeIself + _lhsOself :: FieldDeclaration + _lhsOself = rule300 _self + __result_ = T_FieldDeclaration_vOut46 _lhsOself + in __result_ ) + in C_FieldDeclaration_s47 v46 + {-# INLINE rule299 #-} + rule299 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: AnnotatedType) -> + FieldDeclaration_FieldDeclaration _rangeIself _namesIself _typeIself + {-# INLINE rule300 #-} + rule300 = \ _self -> + _self + +-- FieldDeclarations ------------------------------------------- +-- wrapper +data Inh_FieldDeclarations = Inh_FieldDeclarations { } +data Syn_FieldDeclarations = Syn_FieldDeclarations { self_Syn_FieldDeclarations :: (FieldDeclarations) } +{-# INLINABLE wrap_FieldDeclarations #-} +wrap_FieldDeclarations :: T_FieldDeclarations -> Inh_FieldDeclarations -> (Syn_FieldDeclarations ) +wrap_FieldDeclarations (T_FieldDeclarations act) (Inh_FieldDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclarations_vIn49 + (T_FieldDeclarations_vOut49 _lhsOself) <- return (inv_FieldDeclarations_s50 sem arg) + return (Syn_FieldDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FieldDeclarations #-} +sem_FieldDeclarations :: FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations list = Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list) + +-- semantic domain +newtype T_FieldDeclarations = T_FieldDeclarations { + attach_T_FieldDeclarations :: Identity (T_FieldDeclarations_s50 ) + } +newtype T_FieldDeclarations_s50 = C_FieldDeclarations_s50 { + inv_FieldDeclarations_s50 :: (T_FieldDeclarations_v49 ) + } +data T_FieldDeclarations_s51 = C_FieldDeclarations_s51 +type T_FieldDeclarations_v49 = (T_FieldDeclarations_vIn49 ) -> (T_FieldDeclarations_vOut49 ) +data T_FieldDeclarations_vIn49 = T_FieldDeclarations_vIn49 +data T_FieldDeclarations_vOut49 = T_FieldDeclarations_vOut49 (FieldDeclarations) +{-# NOINLINE sem_FieldDeclarations_Cons #-} +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> T_FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations_Cons arg_hd_ arg_tl_ = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _hdX47 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclaration (arg_hd_)) + _tlX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_tl_)) + (T_FieldDeclaration_vOut46 _hdIself) = inv_FieldDeclaration_s47 _hdX47 (T_FieldDeclaration_vIn46 ) + (T_FieldDeclarations_vOut49 _tlIself) = inv_FieldDeclarations_s50 _tlX50 (T_FieldDeclarations_vIn49 ) + _self = rule301 _hdIself _tlIself + _lhsOself :: FieldDeclarations + _lhsOself = rule302 _self + __result_ = T_FieldDeclarations_vOut49 _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule301 #-} + rule301 = \ ((_hdIself) :: FieldDeclaration) ((_tlIself) :: FieldDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule302 #-} + rule302 = \ _self -> + _self +{-# NOINLINE sem_FieldDeclarations_Nil #-} +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _self = rule303 () + _lhsOself :: FieldDeclarations + _lhsOself = rule304 _self + __result_ = T_FieldDeclarations_vOut49 _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule303 #-} + rule303 = \ (_ :: ()) -> + [] + {-# INLINE rule304 #-} + rule304 = \ _self -> + _self + +-- Fixity ------------------------------------------------------ +-- wrapper +data Inh_Fixity = Inh_Fixity { } +data Syn_Fixity = Syn_Fixity { self_Syn_Fixity :: (Fixity) } +{-# INLINABLE wrap_Fixity #-} +wrap_Fixity :: T_Fixity -> Inh_Fixity -> (Syn_Fixity ) +wrap_Fixity (T_Fixity act) (Inh_Fixity ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Fixity_vIn52 + (T_Fixity_vOut52 _lhsOself) <- return (inv_Fixity_s53 sem arg) + return (Syn_Fixity _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Fixity #-} +sem_Fixity :: Fixity -> T_Fixity +sem_Fixity ( Fixity_Infixl range_ ) = sem_Fixity_Infixl ( sem_Range range_ ) +sem_Fixity ( Fixity_Infixr range_ ) = sem_Fixity_Infixr ( sem_Range range_ ) +sem_Fixity ( Fixity_Infix range_ ) = sem_Fixity_Infix ( sem_Range range_ ) + +-- semantic domain +newtype T_Fixity = T_Fixity { + attach_T_Fixity :: Identity (T_Fixity_s53 ) + } +newtype T_Fixity_s53 = C_Fixity_s53 { + inv_Fixity_s53 :: (T_Fixity_v52 ) + } +data T_Fixity_s54 = C_Fixity_s54 +type T_Fixity_v52 = (T_Fixity_vIn52 ) -> (T_Fixity_vOut52 ) +data T_Fixity_vIn52 = T_Fixity_vIn52 +data T_Fixity_vOut52 = T_Fixity_vOut52 (Fixity) +{-# NOINLINE sem_Fixity_Infixl #-} +sem_Fixity_Infixl :: T_Range -> T_Fixity +sem_Fixity_Infixl arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule305 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule306 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule305 #-} + rule305 = \ ((_rangeIself) :: Range) -> + Fixity_Infixl _rangeIself + {-# INLINE rule306 #-} + rule306 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infixr #-} +sem_Fixity_Infixr :: T_Range -> T_Fixity +sem_Fixity_Infixr arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule307 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule308 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule307 #-} + rule307 = \ ((_rangeIself) :: Range) -> + Fixity_Infixr _rangeIself + {-# INLINE rule308 #-} + rule308 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infix #-} +sem_Fixity_Infix :: T_Range -> T_Fixity +sem_Fixity_Infix arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule309 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule310 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule309 #-} + rule309 = \ ((_rangeIself) :: Range) -> + Fixity_Infix _rangeIself + {-# INLINE rule310 #-} + rule310 = \ _self -> + _self + +-- FunctionBinding --------------------------------------------- +-- wrapper +data Inh_FunctionBinding = Inh_FunctionBinding { dictionaryEnv_Inh_FunctionBinding :: (DictionaryEnvironment), ids_Inh_FunctionBinding :: ( [Id] ) } +data Syn_FunctionBinding = Syn_FunctionBinding { arity_Syn_FunctionBinding :: (Int), core_Syn_FunctionBinding :: ( Core.Expr -> Core.Expr ), name_Syn_FunctionBinding :: (Name), self_Syn_FunctionBinding :: (FunctionBinding) } +{-# INLINABLE wrap_FunctionBinding #-} +wrap_FunctionBinding :: T_FunctionBinding -> Inh_FunctionBinding -> (Syn_FunctionBinding ) +wrap_FunctionBinding (T_FunctionBinding act) (Inh_FunctionBinding _lhsIdictionaryEnv _lhsIids) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBinding_vIn55 _lhsIdictionaryEnv _lhsIids + (T_FunctionBinding_vOut55 _lhsOarity _lhsOcore _lhsOname _lhsOself) <- return (inv_FunctionBinding_s56 sem arg) + return (Syn_FunctionBinding _lhsOarity _lhsOcore _lhsOname _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBinding #-} +sem_FunctionBinding :: FunctionBinding -> T_FunctionBinding +sem_FunctionBinding ( FunctionBinding_Hole range_ id_ ) = sem_FunctionBinding_Hole ( sem_Range range_ ) id_ +sem_FunctionBinding ( FunctionBinding_Feedback range_ feedback_ functionBinding_ ) = sem_FunctionBinding_Feedback ( sem_Range range_ ) feedback_ ( sem_FunctionBinding functionBinding_ ) +sem_FunctionBinding ( FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ ) = sem_FunctionBinding_FunctionBinding ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_RightHandSide righthandside_ ) + +-- semantic domain +newtype T_FunctionBinding = T_FunctionBinding { + attach_T_FunctionBinding :: Identity (T_FunctionBinding_s56 ) + } +newtype T_FunctionBinding_s56 = C_FunctionBinding_s56 { + inv_FunctionBinding_s56 :: (T_FunctionBinding_v55 ) + } +data T_FunctionBinding_s57 = C_FunctionBinding_s57 +type T_FunctionBinding_v55 = (T_FunctionBinding_vIn55 ) -> (T_FunctionBinding_vOut55 ) +data T_FunctionBinding_vIn55 = T_FunctionBinding_vIn55 (DictionaryEnvironment) ( [Id] ) +data T_FunctionBinding_vOut55 = T_FunctionBinding_vOut55 (Int) ( Core.Expr -> Core.Expr ) (Name) (FunctionBinding) +{-# NOINLINE sem_FunctionBinding_Hole #-} +sem_FunctionBinding_Hole :: T_Range -> (Integer) -> T_FunctionBinding +sem_FunctionBinding_Hole arg_range_ arg_id_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIdictionaryEnv _lhsIids) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOarity :: Int + _lhsOarity = rule311 () + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule312 () + _lhsOname :: Name + _lhsOname = rule313 () + _self = rule314 _rangeIself arg_id_ + _lhsOself :: FunctionBinding + _lhsOself = rule315 _self + __result_ = T_FunctionBinding_vOut55 _lhsOarity _lhsOcore _lhsOname _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule311 #-} + rule311 = \ (_ :: ()) -> + 0 + {-# INLINE rule312 #-} + rule312 = \ (_ :: ()) -> + internalError "ToCoreDecl" "FunctionBinding" "holes not supported" + {-# INLINE rule313 #-} + rule313 = \ (_ :: ()) -> + internalError "ToCoreName.ag" "n/a" "hole FunctionBindings" + {-# INLINE rule314 #-} + rule314 = \ ((_rangeIself) :: Range) id_ -> + FunctionBinding_Hole _rangeIself id_ + {-# INLINE rule315 #-} + rule315 = \ _self -> + _self +{-# NOINLINE sem_FunctionBinding_Feedback #-} +sem_FunctionBinding_Feedback :: T_Range -> (String) -> T_FunctionBinding -> T_FunctionBinding +sem_FunctionBinding_Feedback arg_range_ arg_feedback_ arg_functionBinding_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIdictionaryEnv _lhsIids) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionBindingX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_functionBinding_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBinding_vOut55 _functionBindingIarity _functionBindingIcore _functionBindingIname _functionBindingIself) = inv_FunctionBinding_s56 _functionBindingX56 (T_FunctionBinding_vIn55 _functionBindingOdictionaryEnv _functionBindingOids) + _self = rule316 _functionBindingIself _rangeIself arg_feedback_ + _lhsOself :: FunctionBinding + _lhsOself = rule317 _self + _lhsOarity :: Int + _lhsOarity = rule318 _functionBindingIarity + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule319 _functionBindingIcore + _lhsOname :: Name + _lhsOname = rule320 _functionBindingIname + _functionBindingOdictionaryEnv = rule321 _lhsIdictionaryEnv + _functionBindingOids = rule322 _lhsIids + __result_ = T_FunctionBinding_vOut55 _lhsOarity _lhsOcore _lhsOname _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule316 #-} + rule316 = \ ((_functionBindingIself) :: FunctionBinding) ((_rangeIself) :: Range) feedback_ -> + FunctionBinding_Feedback _rangeIself feedback_ _functionBindingIself + {-# INLINE rule317 #-} + rule317 = \ _self -> + _self + {-# INLINE rule318 #-} + rule318 = \ ((_functionBindingIarity) :: Int) -> + _functionBindingIarity + {-# INLINE rule319 #-} + rule319 = \ ((_functionBindingIcore) :: Core.Expr -> Core.Expr ) -> + _functionBindingIcore + {-# INLINE rule320 #-} + rule320 = \ ((_functionBindingIname) :: Name) -> + _functionBindingIname + {-# INLINE rule321 #-} + rule321 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule322 #-} + rule322 = \ ((_lhsIids) :: [Id] ) -> + _lhsIids +{-# NOINLINE sem_FunctionBinding_FunctionBinding #-} +sem_FunctionBinding_FunctionBinding :: T_Range -> T_LeftHandSide -> T_RightHandSide -> T_FunctionBinding +sem_FunctionBinding_FunctionBinding arg_range_ arg_lefthandside_ arg_righthandside_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIdictionaryEnv _lhsIids) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIarity _lefthandsideIname _lefthandsideIpatterns _lefthandsideIself) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 ) + (T_RightHandSide_vOut148 _righthandsideIcore _righthandsideIisGuarded _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOdictionaryEnv) + _lhsOarity :: Int + _lhsOarity = rule323 _lefthandsideIarity + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule324 _lefthandsideIpatterns _lhsIids _righthandsideIcore _righthandsideIisGuarded + _self = rule325 _lefthandsideIself _rangeIself _righthandsideIself + _lhsOself :: FunctionBinding + _lhsOself = rule326 _self + _lhsOname :: Name + _lhsOname = rule327 _lefthandsideIname + _righthandsideOdictionaryEnv = rule328 _lhsIdictionaryEnv + __result_ = T_FunctionBinding_vOut55 _lhsOarity _lhsOcore _lhsOname _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule323 #-} + rule323 = \ ((_lefthandsideIarity) :: Int) -> + _lefthandsideIarity + {-# INLINE rule324 #-} + rule324 = \ ((_lefthandsideIpatterns) :: Patterns) ((_lhsIids) :: [Id] ) ((_righthandsideIcore) :: Core.Expr ) ((_righthandsideIisGuarded) :: Bool) -> + \nextClause -> + let thisClause = + patternsToCore + (zip _lhsIids _lefthandsideIpatterns) + _righthandsideIcore in + if all patternAlwaysSucceeds _lefthandsideIpatterns + && + not _righthandsideIisGuarded + then + thisClause + else + let_ nextClauseId nextClause thisClause + {-# INLINE rule325 #-} + rule325 = \ ((_lefthandsideIself) :: LeftHandSide) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + FunctionBinding_FunctionBinding _rangeIself _lefthandsideIself _righthandsideIself + {-# INLINE rule326 #-} + rule326 = \ _self -> + _self + {-# INLINE rule327 #-} + rule327 = \ ((_lefthandsideIname) :: Name) -> + _lefthandsideIname + {-# INLINE rule328 #-} + rule328 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + +-- FunctionBindings -------------------------------------------- +-- wrapper +data Inh_FunctionBindings = Inh_FunctionBindings { dictionaryEnv_Inh_FunctionBindings :: (DictionaryEnvironment), ids_Inh_FunctionBindings :: ( [Id] ), range_Inh_FunctionBindings :: (Range) } +data Syn_FunctionBindings = Syn_FunctionBindings { arity_Syn_FunctionBindings :: (Int), core_Syn_FunctionBindings :: (Core.Expr), name_Syn_FunctionBindings :: (Name), self_Syn_FunctionBindings :: (FunctionBindings) } +{-# INLINABLE wrap_FunctionBindings #-} +wrap_FunctionBindings :: T_FunctionBindings -> Inh_FunctionBindings -> (Syn_FunctionBindings ) +wrap_FunctionBindings (T_FunctionBindings act) (Inh_FunctionBindings _lhsIdictionaryEnv _lhsIids _lhsIrange) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBindings_vIn58 _lhsIdictionaryEnv _lhsIids _lhsIrange + (T_FunctionBindings_vOut58 _lhsOarity _lhsOcore _lhsOname _lhsOself) <- return (inv_FunctionBindings_s59 sem arg) + return (Syn_FunctionBindings _lhsOarity _lhsOcore _lhsOname _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBindings #-} +sem_FunctionBindings :: FunctionBindings -> T_FunctionBindings +sem_FunctionBindings list = Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list) + +-- semantic domain +newtype T_FunctionBindings = T_FunctionBindings { + attach_T_FunctionBindings :: Identity (T_FunctionBindings_s59 ) + } +newtype T_FunctionBindings_s59 = C_FunctionBindings_s59 { + inv_FunctionBindings_s59 :: (T_FunctionBindings_v58 ) + } +data T_FunctionBindings_s60 = C_FunctionBindings_s60 +type T_FunctionBindings_v58 = (T_FunctionBindings_vIn58 ) -> (T_FunctionBindings_vOut58 ) +data T_FunctionBindings_vIn58 = T_FunctionBindings_vIn58 (DictionaryEnvironment) ( [Id] ) (Range) +data T_FunctionBindings_vOut58 = T_FunctionBindings_vOut58 (Int) (Core.Expr) (Name) (FunctionBindings) +{-# NOINLINE sem_FunctionBindings_Cons #-} +sem_FunctionBindings_Cons :: T_FunctionBinding -> T_FunctionBindings -> T_FunctionBindings +sem_FunctionBindings_Cons arg_hd_ arg_tl_ = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 _lhsIdictionaryEnv _lhsIids _lhsIrange) -> ( let + _hdX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_hd_)) + _tlX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_tl_)) + (T_FunctionBinding_vOut55 _hdIarity _hdIcore _hdIname _hdIself) = inv_FunctionBinding_s56 _hdX56 (T_FunctionBinding_vIn55 _hdOdictionaryEnv _hdOids) + (T_FunctionBindings_vOut58 _tlIarity _tlIcore _tlIname _tlIself) = inv_FunctionBindings_s59 _tlX59 (T_FunctionBindings_vIn58 _tlOdictionaryEnv _tlOids _tlOrange) + _lhsOcore :: Core.Expr + _lhsOcore = rule329 _hdIcore _tlIcore + _lhsOarity :: Int + _lhsOarity = rule330 _hdIarity + _lhsOname :: Name + _lhsOname = rule331 _hdIname + _self = rule332 _hdIself _tlIself + _lhsOself :: FunctionBindings + _lhsOself = rule333 _self + _hdOdictionaryEnv = rule334 _lhsIdictionaryEnv + _hdOids = rule335 _lhsIids + _tlOdictionaryEnv = rule336 _lhsIdictionaryEnv + _tlOids = rule337 _lhsIids + _tlOrange = rule338 _lhsIrange + __result_ = T_FunctionBindings_vOut58 _lhsOarity _lhsOcore _lhsOname _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule329 #-} + rule329 = \ ((_hdIcore) :: Core.Expr -> Core.Expr ) ((_tlIcore) :: Core.Expr) -> + _hdIcore _tlIcore + {-# INLINE rule330 #-} + rule330 = \ ((_hdIarity) :: Int) -> + _hdIarity + {-# INLINE rule331 #-} + rule331 = \ ((_hdIname) :: Name) -> + _hdIname + {-# INLINE rule332 #-} + rule332 = \ ((_hdIself) :: FunctionBinding) ((_tlIself) :: FunctionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule333 #-} + rule333 = \ _self -> + _self + {-# INLINE rule334 #-} + rule334 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule335 #-} + rule335 = \ ((_lhsIids) :: [Id] ) -> + _lhsIids + {-# INLINE rule336 #-} + rule336 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule337 #-} + rule337 = \ ((_lhsIids) :: [Id] ) -> + _lhsIids + {-# INLINE rule338 #-} + rule338 = \ ((_lhsIrange) :: Range) -> + _lhsIrange +{-# NOINLINE sem_FunctionBindings_Nil #-} +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 _lhsIdictionaryEnv _lhsIids _lhsIrange) -> ( let + _lhsOcore :: Core.Expr + _lhsOcore = rule339 _lhsIrange + _lhsOarity :: Int + _lhsOarity = rule340 () + _lhsOname :: Name + _lhsOname = rule341 () + _self = rule342 () + _lhsOself :: FunctionBindings + _lhsOself = rule343 _self + __result_ = T_FunctionBindings_vOut58 _lhsOarity _lhsOcore _lhsOname _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule339 #-} + rule339 = \ ((_lhsIrange) :: Range) -> + patternMatchFail "function bindings" _lhsIrange + {-# INLINE rule340 #-} + rule340 = \ (_ :: ()) -> + internalError "ToCoreDecl" "FunctionBindings" "arity: empty list of function bindings" + {-# INLINE rule341 #-} + rule341 = \ (_ :: ()) -> + internalError "ToCoreName.ag" "n/a" "empty FunctionBindings" + {-# INLINE rule342 #-} + rule342 = \ (_ :: ()) -> + [] + {-# INLINE rule343 #-} + rule343 = \ _self -> + _self + +-- GuardedExpression ------------------------------------------- +-- wrapper +data Inh_GuardedExpression = Inh_GuardedExpression { dictionaryEnv_Inh_GuardedExpression :: (DictionaryEnvironment) } +data Syn_GuardedExpression = Syn_GuardedExpression { core_Syn_GuardedExpression :: ( Core.Expr -> Core.Expr ), self_Syn_GuardedExpression :: (GuardedExpression) } +{-# INLINABLE wrap_GuardedExpression #-} +wrap_GuardedExpression :: T_GuardedExpression -> Inh_GuardedExpression -> (Syn_GuardedExpression ) +wrap_GuardedExpression (T_GuardedExpression act) (Inh_GuardedExpression _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpression_vIn61 _lhsIdictionaryEnv + (T_GuardedExpression_vOut61 _lhsOcore _lhsOself) <- return (inv_GuardedExpression_s62 sem arg) + return (Syn_GuardedExpression _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpression #-} +sem_GuardedExpression :: GuardedExpression -> T_GuardedExpression +sem_GuardedExpression ( GuardedExpression_GuardedExpression range_ guard_ expression_ ) = sem_GuardedExpression_GuardedExpression ( sem_Range range_ ) ( sem_Expression guard_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_GuardedExpression = T_GuardedExpression { + attach_T_GuardedExpression :: Identity (T_GuardedExpression_s62 ) + } +newtype T_GuardedExpression_s62 = C_GuardedExpression_s62 { + inv_GuardedExpression_s62 :: (T_GuardedExpression_v61 ) + } +data T_GuardedExpression_s63 = C_GuardedExpression_s63 +type T_GuardedExpression_v61 = (T_GuardedExpression_vIn61 ) -> (T_GuardedExpression_vOut61 ) +data T_GuardedExpression_vIn61 = T_GuardedExpression_vIn61 (DictionaryEnvironment) +data T_GuardedExpression_vOut61 = T_GuardedExpression_vOut61 ( Core.Expr -> Core.Expr ) (GuardedExpression) +{-# NOINLINE sem_GuardedExpression_GuardedExpression #-} +sem_GuardedExpression_GuardedExpression :: T_Range -> T_Expression -> T_Expression -> T_GuardedExpression +sem_GuardedExpression_GuardedExpression arg_range_ arg_guard_ arg_expression_ = T_GuardedExpression (return st62) where + {-# NOINLINE st62 #-} + st62 = let + v61 :: T_GuardedExpression_v61 + v61 = \ (T_GuardedExpression_vIn61 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIcore _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 _guardOdictionaryEnv) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule344 _expressionIcore _guardIcore + _self = rule345 _expressionIself _guardIself _rangeIself + _lhsOself :: GuardedExpression + _lhsOself = rule346 _self + _guardOdictionaryEnv = rule347 _lhsIdictionaryEnv + _expressionOdictionaryEnv = rule348 _lhsIdictionaryEnv + __result_ = T_GuardedExpression_vOut61 _lhsOcore _lhsOself + in __result_ ) + in C_GuardedExpression_s62 v61 + {-# INLINE rule344 #-} + rule344 = \ ((_expressionIcore) :: Core.Expr ) ((_guardIcore) :: Core.Expr ) -> + \fail' -> if_ _guardIcore _expressionIcore fail' + {-# INLINE rule345 #-} + rule345 = \ ((_expressionIself) :: Expression) ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + GuardedExpression_GuardedExpression _rangeIself _guardIself _expressionIself + {-# INLINE rule346 #-} + rule346 = \ _self -> + _self + {-# INLINE rule347 #-} + rule347 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule348 #-} + rule348 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + +-- GuardedExpressions ------------------------------------------ +-- wrapper +data Inh_GuardedExpressions = Inh_GuardedExpressions { dictionaryEnv_Inh_GuardedExpressions :: (DictionaryEnvironment) } +data Syn_GuardedExpressions = Syn_GuardedExpressions { core_Syn_GuardedExpressions :: ( [Core.Expr -> Core.Expr] ), self_Syn_GuardedExpressions :: (GuardedExpressions) } +{-# INLINABLE wrap_GuardedExpressions #-} +wrap_GuardedExpressions :: T_GuardedExpressions -> Inh_GuardedExpressions -> (Syn_GuardedExpressions ) +wrap_GuardedExpressions (T_GuardedExpressions act) (Inh_GuardedExpressions _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpressions_vIn64 _lhsIdictionaryEnv + (T_GuardedExpressions_vOut64 _lhsOcore _lhsOself) <- return (inv_GuardedExpressions_s65 sem arg) + return (Syn_GuardedExpressions _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpressions #-} +sem_GuardedExpressions :: GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions list = Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list) + +-- semantic domain +newtype T_GuardedExpressions = T_GuardedExpressions { + attach_T_GuardedExpressions :: Identity (T_GuardedExpressions_s65 ) + } +newtype T_GuardedExpressions_s65 = C_GuardedExpressions_s65 { + inv_GuardedExpressions_s65 :: (T_GuardedExpressions_v64 ) + } +data T_GuardedExpressions_s66 = C_GuardedExpressions_s66 +type T_GuardedExpressions_v64 = (T_GuardedExpressions_vIn64 ) -> (T_GuardedExpressions_vOut64 ) +data T_GuardedExpressions_vIn64 = T_GuardedExpressions_vIn64 (DictionaryEnvironment) +data T_GuardedExpressions_vOut64 = T_GuardedExpressions_vOut64 ( [Core.Expr -> Core.Expr] ) (GuardedExpressions) +{-# NOINLINE sem_GuardedExpressions_Cons #-} +sem_GuardedExpressions_Cons :: T_GuardedExpression -> T_GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions_Cons arg_hd_ arg_tl_ = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 _lhsIdictionaryEnv) -> ( let + _hdX62 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpression (arg_hd_)) + _tlX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_tl_)) + (T_GuardedExpression_vOut61 _hdIcore _hdIself) = inv_GuardedExpression_s62 _hdX62 (T_GuardedExpression_vIn61 _hdOdictionaryEnv) + (T_GuardedExpressions_vOut64 _tlIcore _tlIself) = inv_GuardedExpressions_s65 _tlX65 (T_GuardedExpressions_vIn64 _tlOdictionaryEnv) + _lhsOcore :: [Core.Expr -> Core.Expr] + _lhsOcore = rule349 _hdIcore _tlIcore + _self = rule350 _hdIself _tlIself + _lhsOself :: GuardedExpressions + _lhsOself = rule351 _self + _hdOdictionaryEnv = rule352 _lhsIdictionaryEnv + _tlOdictionaryEnv = rule353 _lhsIdictionaryEnv + __result_ = T_GuardedExpressions_vOut64 _lhsOcore _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule349 #-} + rule349 = \ ((_hdIcore) :: Core.Expr -> Core.Expr ) ((_tlIcore) :: [Core.Expr -> Core.Expr] ) -> + _hdIcore : _tlIcore + {-# INLINE rule350 #-} + rule350 = \ ((_hdIself) :: GuardedExpression) ((_tlIself) :: GuardedExpressions) -> + (:) _hdIself _tlIself + {-# INLINE rule351 #-} + rule351 = \ _self -> + _self + {-# INLINE rule352 #-} + rule352 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule353 #-} + rule353 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_GuardedExpressions_Nil #-} +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 _lhsIdictionaryEnv) -> ( let + _lhsOcore :: [Core.Expr -> Core.Expr] + _lhsOcore = rule354 () + _self = rule355 () + _lhsOself :: GuardedExpressions + _lhsOself = rule356 _self + __result_ = T_GuardedExpressions_vOut64 _lhsOcore _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule354 #-} + rule354 = \ (_ :: ()) -> + [] + {-# INLINE rule355 #-} + rule355 = \ (_ :: ()) -> + [] + {-# INLINE rule356 #-} + rule356 = \ _self -> + _self + +-- Import ------------------------------------------------------ +-- wrapper +data Inh_Import = Inh_Import { } +data Syn_Import = Syn_Import { self_Syn_Import :: (Import) } +{-# INLINABLE wrap_Import #-} +wrap_Import :: T_Import -> Inh_Import -> (Syn_Import ) +wrap_Import (T_Import act) (Inh_Import ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Import_vIn67 + (T_Import_vOut67 _lhsOself) <- return (inv_Import_s68 sem arg) + return (Syn_Import _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Import #-} +sem_Import :: Import -> T_Import +sem_Import ( Import_Variable range_ name_ ) = sem_Import_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Import ( Import_TypeOrClass range_ name_ names_ ) = sem_Import_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Import ( Import_TypeOrClassComplete range_ name_ ) = sem_Import_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Import = T_Import { + attach_T_Import :: Identity (T_Import_s68 ) + } +newtype T_Import_s68 = C_Import_s68 { + inv_Import_s68 :: (T_Import_v67 ) + } +data T_Import_s69 = C_Import_s69 +type T_Import_v67 = (T_Import_vIn67 ) -> (T_Import_vOut67 ) +data T_Import_vIn67 = T_Import_vIn67 +data T_Import_vOut67 = T_Import_vOut67 (Import) +{-# NOINLINE sem_Import_Variable #-} +sem_Import_Variable :: T_Range -> T_Name -> T_Import +sem_Import_Variable arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule357 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule358 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule357 #-} + rule357 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_Variable _rangeIself _nameIself + {-# INLINE rule358 #-} + rule358 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClass #-} +sem_Import_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Import +sem_Import_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesInames _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _self = rule359 _nameIself _namesIself _rangeIself + _lhsOself :: Import + _lhsOself = rule360 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule359 #-} + rule359 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Import_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule360 #-} + rule360 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClassComplete #-} +sem_Import_TypeOrClassComplete :: T_Range -> T_Name -> T_Import +sem_Import_TypeOrClassComplete arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule361 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule362 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule361 #-} + rule361 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule362 #-} + rule362 = \ _self -> + _self + +-- ImportDeclaration ------------------------------------------- +-- wrapper +data Inh_ImportDeclaration = Inh_ImportDeclaration { } +data Syn_ImportDeclaration = Syn_ImportDeclaration { self_Syn_ImportDeclaration :: (ImportDeclaration) } +{-# INLINABLE wrap_ImportDeclaration #-} +wrap_ImportDeclaration :: T_ImportDeclaration -> Inh_ImportDeclaration -> (Syn_ImportDeclaration ) +wrap_ImportDeclaration (T_ImportDeclaration act) (Inh_ImportDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclaration_vIn70 + (T_ImportDeclaration_vOut70 _lhsOself) <- return (inv_ImportDeclaration_s71 sem arg) + return (Syn_ImportDeclaration _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclaration #-} +sem_ImportDeclaration :: ImportDeclaration -> T_ImportDeclaration +sem_ImportDeclaration ( ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ ) = sem_ImportDeclaration_Import ( sem_Range range_ ) qualified_ ( sem_Name name_ ) ( sem_MaybeName asname_ ) ( sem_MaybeImportSpecification importspecification_ ) +sem_ImportDeclaration ( ImportDeclaration_Empty range_ ) = sem_ImportDeclaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_ImportDeclaration = T_ImportDeclaration { + attach_T_ImportDeclaration :: Identity (T_ImportDeclaration_s71 ) + } +newtype T_ImportDeclaration_s71 = C_ImportDeclaration_s71 { + inv_ImportDeclaration_s71 :: (T_ImportDeclaration_v70 ) + } +data T_ImportDeclaration_s72 = C_ImportDeclaration_s72 +type T_ImportDeclaration_v70 = (T_ImportDeclaration_vIn70 ) -> (T_ImportDeclaration_vOut70 ) +data T_ImportDeclaration_vIn70 = T_ImportDeclaration_vIn70 +data T_ImportDeclaration_vOut70 = T_ImportDeclaration_vOut70 (ImportDeclaration) +{-# NOINLINE sem_ImportDeclaration_Import #-} +sem_ImportDeclaration_Import :: T_Range -> (Bool) -> T_Name -> T_MaybeName -> T_MaybeImportSpecification -> T_ImportDeclaration +sem_ImportDeclaration_Import arg_range_ arg_qualified_ arg_name_ arg_asname_ arg_importspecification_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _asnameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_asname_)) + _importspecificationX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeImportSpecification (arg_importspecification_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeName_vOut103 _asnameIisNothing _asnameIname _asnameIself) = inv_MaybeName_s104 _asnameX104 (T_MaybeName_vIn103 ) + (T_MaybeImportSpecification_vOut97 _importspecificationIself) = inv_MaybeImportSpecification_s98 _importspecificationX98 (T_MaybeImportSpecification_vIn97 ) + _self = rule363 _asnameIself _importspecificationIself _nameIself _rangeIself arg_qualified_ + _lhsOself :: ImportDeclaration + _lhsOself = rule364 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule363 #-} + rule363 = \ ((_asnameIself) :: MaybeName) ((_importspecificationIself) :: MaybeImportSpecification) ((_nameIself) :: Name) ((_rangeIself) :: Range) qualified_ -> + ImportDeclaration_Import _rangeIself qualified_ _nameIself _asnameIself _importspecificationIself + {-# INLINE rule364 #-} + rule364 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclaration_Empty #-} +sem_ImportDeclaration_Empty :: T_Range -> T_ImportDeclaration +sem_ImportDeclaration_Empty arg_range_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule365 _rangeIself + _lhsOself :: ImportDeclaration + _lhsOself = rule366 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule365 #-} + rule365 = \ ((_rangeIself) :: Range) -> + ImportDeclaration_Empty _rangeIself + {-# INLINE rule366 #-} + rule366 = \ _self -> + _self + +-- ImportDeclarations ------------------------------------------ +-- wrapper +data Inh_ImportDeclarations = Inh_ImportDeclarations { } +data Syn_ImportDeclarations = Syn_ImportDeclarations { self_Syn_ImportDeclarations :: (ImportDeclarations) } +{-# INLINABLE wrap_ImportDeclarations #-} +wrap_ImportDeclarations :: T_ImportDeclarations -> Inh_ImportDeclarations -> (Syn_ImportDeclarations ) +wrap_ImportDeclarations (T_ImportDeclarations act) (Inh_ImportDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclarations_vIn73 + (T_ImportDeclarations_vOut73 _lhsOself) <- return (inv_ImportDeclarations_s74 sem arg) + return (Syn_ImportDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclarations #-} +sem_ImportDeclarations :: ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations list = Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list) + +-- semantic domain +newtype T_ImportDeclarations = T_ImportDeclarations { + attach_T_ImportDeclarations :: Identity (T_ImportDeclarations_s74 ) + } +newtype T_ImportDeclarations_s74 = C_ImportDeclarations_s74 { + inv_ImportDeclarations_s74 :: (T_ImportDeclarations_v73 ) + } +data T_ImportDeclarations_s75 = C_ImportDeclarations_s75 +type T_ImportDeclarations_v73 = (T_ImportDeclarations_vIn73 ) -> (T_ImportDeclarations_vOut73 ) +data T_ImportDeclarations_vIn73 = T_ImportDeclarations_vIn73 +data T_ImportDeclarations_vOut73 = T_ImportDeclarations_vOut73 (ImportDeclarations) +{-# NOINLINE sem_ImportDeclarations_Cons #-} +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> T_ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations_Cons arg_hd_ arg_tl_ = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _hdX71 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclaration (arg_hd_)) + _tlX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_tl_)) + (T_ImportDeclaration_vOut70 _hdIself) = inv_ImportDeclaration_s71 _hdX71 (T_ImportDeclaration_vIn70 ) + (T_ImportDeclarations_vOut73 _tlIself) = inv_ImportDeclarations_s74 _tlX74 (T_ImportDeclarations_vIn73 ) + _self = rule367 _hdIself _tlIself + _lhsOself :: ImportDeclarations + _lhsOself = rule368 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule367 #-} + rule367 = \ ((_hdIself) :: ImportDeclaration) ((_tlIself) :: ImportDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule368 #-} + rule368 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclarations_Nil #-} +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _self = rule369 () + _lhsOself :: ImportDeclarations + _lhsOself = rule370 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule369 #-} + rule369 = \ (_ :: ()) -> + [] + {-# INLINE rule370 #-} + rule370 = \ _self -> + _self + +-- ImportSpecification ----------------------------------------- +-- wrapper +data Inh_ImportSpecification = Inh_ImportSpecification { } +data Syn_ImportSpecification = Syn_ImportSpecification { self_Syn_ImportSpecification :: (ImportSpecification) } +{-# INLINABLE wrap_ImportSpecification #-} +wrap_ImportSpecification :: T_ImportSpecification -> Inh_ImportSpecification -> (Syn_ImportSpecification ) +wrap_ImportSpecification (T_ImportSpecification act) (Inh_ImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportSpecification_vIn76 + (T_ImportSpecification_vOut76 _lhsOself) <- return (inv_ImportSpecification_s77 sem arg) + return (Syn_ImportSpecification _lhsOself) + ) + +-- cata +{-# INLINE sem_ImportSpecification #-} +sem_ImportSpecification :: ImportSpecification -> T_ImportSpecification +sem_ImportSpecification ( ImportSpecification_Import range_ hiding_ imports_ ) = sem_ImportSpecification_Import ( sem_Range range_ ) hiding_ ( sem_Imports imports_ ) + +-- semantic domain +newtype T_ImportSpecification = T_ImportSpecification { + attach_T_ImportSpecification :: Identity (T_ImportSpecification_s77 ) + } +newtype T_ImportSpecification_s77 = C_ImportSpecification_s77 { + inv_ImportSpecification_s77 :: (T_ImportSpecification_v76 ) + } +data T_ImportSpecification_s78 = C_ImportSpecification_s78 +type T_ImportSpecification_v76 = (T_ImportSpecification_vIn76 ) -> (T_ImportSpecification_vOut76 ) +data T_ImportSpecification_vIn76 = T_ImportSpecification_vIn76 +data T_ImportSpecification_vOut76 = T_ImportSpecification_vOut76 (ImportSpecification) +{-# NOINLINE sem_ImportSpecification_Import #-} +sem_ImportSpecification_Import :: T_Range -> (Bool) -> T_Imports -> T_ImportSpecification +sem_ImportSpecification_Import arg_range_ arg_hiding_ arg_imports_ = T_ImportSpecification (return st77) where + {-# NOINLINE st77 #-} + st77 = let + v76 :: T_ImportSpecification_v76 + v76 = \ (T_ImportSpecification_vIn76 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importsX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_imports_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Imports_vOut79 _importsIself) = inv_Imports_s80 _importsX80 (T_Imports_vIn79 ) + _self = rule371 _importsIself _rangeIself arg_hiding_ + _lhsOself :: ImportSpecification + _lhsOself = rule372 _self + __result_ = T_ImportSpecification_vOut76 _lhsOself + in __result_ ) + in C_ImportSpecification_s77 v76 + {-# INLINE rule371 #-} + rule371 = \ ((_importsIself) :: Imports) ((_rangeIself) :: Range) hiding_ -> + ImportSpecification_Import _rangeIself hiding_ _importsIself + {-# INLINE rule372 #-} + rule372 = \ _self -> + _self + +-- Imports ----------------------------------------------------- +-- wrapper +data Inh_Imports = Inh_Imports { } +data Syn_Imports = Syn_Imports { self_Syn_Imports :: (Imports) } +{-# INLINABLE wrap_Imports #-} +wrap_Imports :: T_Imports -> Inh_Imports -> (Syn_Imports ) +wrap_Imports (T_Imports act) (Inh_Imports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Imports_vIn79 + (T_Imports_vOut79 _lhsOself) <- return (inv_Imports_s80 sem arg) + return (Syn_Imports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Imports #-} +sem_Imports :: Imports -> T_Imports +sem_Imports list = Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list) + +-- semantic domain +newtype T_Imports = T_Imports { + attach_T_Imports :: Identity (T_Imports_s80 ) + } +newtype T_Imports_s80 = C_Imports_s80 { + inv_Imports_s80 :: (T_Imports_v79 ) + } +data T_Imports_s81 = C_Imports_s81 +type T_Imports_v79 = (T_Imports_vIn79 ) -> (T_Imports_vOut79 ) +data T_Imports_vIn79 = T_Imports_vIn79 +data T_Imports_vOut79 = T_Imports_vOut79 (Imports) +{-# NOINLINE sem_Imports_Cons #-} +sem_Imports_Cons :: T_Import -> T_Imports -> T_Imports +sem_Imports_Cons arg_hd_ arg_tl_ = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _hdX68 = Control.Monad.Identity.runIdentity (attach_T_Import (arg_hd_)) + _tlX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_tl_)) + (T_Import_vOut67 _hdIself) = inv_Import_s68 _hdX68 (T_Import_vIn67 ) + (T_Imports_vOut79 _tlIself) = inv_Imports_s80 _tlX80 (T_Imports_vIn79 ) + _self = rule373 _hdIself _tlIself + _lhsOself :: Imports + _lhsOself = rule374 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule373 #-} + rule373 = \ ((_hdIself) :: Import) ((_tlIself) :: Imports) -> + (:) _hdIself _tlIself + {-# INLINE rule374 #-} + rule374 = \ _self -> + _self +{-# NOINLINE sem_Imports_Nil #-} +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _self = rule375 () + _lhsOself :: Imports + _lhsOself = rule376 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule375 #-} + rule375 = \ (_ :: ()) -> + [] + {-# INLINE rule376 #-} + rule376 = \ _self -> + _self + +-- LeftHandSide ------------------------------------------------ +-- wrapper +data Inh_LeftHandSide = Inh_LeftHandSide { } +data Syn_LeftHandSide = Syn_LeftHandSide { arity_Syn_LeftHandSide :: (Int), name_Syn_LeftHandSide :: (Name), patterns_Syn_LeftHandSide :: (Patterns), self_Syn_LeftHandSide :: (LeftHandSide) } +{-# INLINABLE wrap_LeftHandSide #-} +wrap_LeftHandSide :: T_LeftHandSide -> Inh_LeftHandSide -> (Syn_LeftHandSide ) +wrap_LeftHandSide (T_LeftHandSide act) (Inh_LeftHandSide ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_LeftHandSide_vIn82 + (T_LeftHandSide_vOut82 _lhsOarity _lhsOname _lhsOpatterns _lhsOself) <- return (inv_LeftHandSide_s83 sem arg) + return (Syn_LeftHandSide _lhsOarity _lhsOname _lhsOpatterns _lhsOself) + ) + +-- cata +{-# NOINLINE sem_LeftHandSide #-} +sem_LeftHandSide :: LeftHandSide -> T_LeftHandSide +sem_LeftHandSide ( LeftHandSide_Function range_ name_ patterns_ ) = sem_LeftHandSide_Function ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_LeftHandSide ( LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ ) = sem_LeftHandSide_Infix ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name operator_ ) ( sem_Pattern rightPattern_ ) +sem_LeftHandSide ( LeftHandSide_Parenthesized range_ lefthandside_ patterns_ ) = sem_LeftHandSide_Parenthesized ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_Patterns patterns_ ) + +-- semantic domain +newtype T_LeftHandSide = T_LeftHandSide { + attach_T_LeftHandSide :: Identity (T_LeftHandSide_s83 ) + } +newtype T_LeftHandSide_s83 = C_LeftHandSide_s83 { + inv_LeftHandSide_s83 :: (T_LeftHandSide_v82 ) + } +data T_LeftHandSide_s84 = C_LeftHandSide_s84 +type T_LeftHandSide_v82 = (T_LeftHandSide_vIn82 ) -> (T_LeftHandSide_vOut82 ) +data T_LeftHandSide_vIn82 = T_LeftHandSide_vIn82 +data T_LeftHandSide_vOut82 = T_LeftHandSide_vOut82 (Int) (Name) (Patterns) (LeftHandSide) +{-# NOINLINE sem_LeftHandSide_Function #-} +sem_LeftHandSide_Function :: T_Range -> T_Name -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Function arg_range_ arg_name_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIlength _patternsIself _patternsIvars) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _lhsOarity :: Int + _lhsOarity = rule377 _patternsIlength + _lhsOpatterns :: Patterns + _lhsOpatterns = rule378 _patternsIself + _lhsOname :: Name + _lhsOname = rule379 _nameIself + _self = rule380 _nameIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule381 _self + __result_ = T_LeftHandSide_vOut82 _lhsOarity _lhsOname _lhsOpatterns _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule377 #-} + rule377 = \ ((_patternsIlength) :: Int) -> + _patternsIlength + {-# INLINE rule378 #-} + rule378 = \ ((_patternsIself) :: Patterns) -> + _patternsIself + {-# INLINE rule379 #-} + rule379 = \ ((_nameIself) :: Name) -> + _nameIself + {-# INLINE rule380 #-} + rule380 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Function _rangeIself _nameIself _patternsIself + {-# INLINE rule381 #-} + rule381 = \ _self -> + _self +{-# NOINLINE sem_LeftHandSide_Infix #-} +sem_LeftHandSide_Infix :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_LeftHandSide +sem_LeftHandSide_Infix arg_range_ arg_leftPattern_ arg_operator_ arg_rightPattern_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _operatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_operator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIself _leftPatternIvars) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 ) + (T_Name_vOut112 _operatorIself) = inv_Name_s113 _operatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIself _rightPatternIvars) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 ) + _lhsOarity :: Int + _lhsOarity = rule382 () + _lhsOpatterns :: Patterns + _lhsOpatterns = rule383 _leftPatternIself _rightPatternIself + _lhsOname :: Name + _lhsOname = rule384 _operatorIself + _self = rule385 _leftPatternIself _operatorIself _rangeIself _rightPatternIself + _lhsOself :: LeftHandSide + _lhsOself = rule386 _self + __result_ = T_LeftHandSide_vOut82 _lhsOarity _lhsOname _lhsOpatterns _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule382 #-} + rule382 = \ (_ :: ()) -> + 2 + {-# INLINE rule383 #-} + rule383 = \ ((_leftPatternIself) :: Pattern) ((_rightPatternIself) :: Pattern) -> + [_leftPatternIself, _rightPatternIself ] + {-# INLINE rule384 #-} + rule384 = \ ((_operatorIself) :: Name) -> + _operatorIself + {-# INLINE rule385 #-} + rule385 = \ ((_leftPatternIself) :: Pattern) ((_operatorIself) :: Name) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + LeftHandSide_Infix _rangeIself _leftPatternIself _operatorIself _rightPatternIself + {-# INLINE rule386 #-} + rule386 = \ _self -> + _self +{-# NOINLINE sem_LeftHandSide_Parenthesized #-} +sem_LeftHandSide_Parenthesized :: T_Range -> T_LeftHandSide -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Parenthesized arg_range_ arg_lefthandside_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIarity _lefthandsideIname _lefthandsideIpatterns _lefthandsideIself) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 ) + (T_Patterns_vOut121 _patternsIlength _patternsIself _patternsIvars) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _lhsOarity :: Int + _lhsOarity = rule387 _lefthandsideIarity _patternsIlength + _lhsOpatterns :: Patterns + _lhsOpatterns = rule388 _lefthandsideIpatterns _patternsIself + _self = rule389 _lefthandsideIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule390 _self + _lhsOname :: Name + _lhsOname = rule391 _lefthandsideIname + __result_ = T_LeftHandSide_vOut82 _lhsOarity _lhsOname _lhsOpatterns _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule387 #-} + rule387 = \ ((_lefthandsideIarity) :: Int) ((_patternsIlength) :: Int) -> + _lefthandsideIarity + _patternsIlength + {-# INLINE rule388 #-} + rule388 = \ ((_lefthandsideIpatterns) :: Patterns) ((_patternsIself) :: Patterns) -> + _lefthandsideIpatterns ++ _patternsIself + {-# INLINE rule389 #-} + rule389 = \ ((_lefthandsideIself) :: LeftHandSide) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Parenthesized _rangeIself _lefthandsideIself _patternsIself + {-# INLINE rule390 #-} + rule390 = \ _self -> + _self + {-# INLINE rule391 #-} + rule391 = \ ((_lefthandsideIname) :: Name) -> + _lefthandsideIname + +-- Literal ----------------------------------------------------- +-- wrapper +data Inh_Literal = Inh_Literal { } +data Syn_Literal = Syn_Literal { core_Syn_Literal :: ( Core.Expr ), self_Syn_Literal :: (Literal) } +{-# INLINABLE wrap_Literal #-} +wrap_Literal :: T_Literal -> Inh_Literal -> (Syn_Literal ) +wrap_Literal (T_Literal act) (Inh_Literal ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Literal_vIn85 + (T_Literal_vOut85 _lhsOcore _lhsOself) <- return (inv_Literal_s86 sem arg) + return (Syn_Literal _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Literal #-} +sem_Literal :: Literal -> T_Literal +sem_Literal ( Literal_Int range_ value_ ) = sem_Literal_Int ( sem_Range range_ ) value_ +sem_Literal ( Literal_Char range_ value_ ) = sem_Literal_Char ( sem_Range range_ ) value_ +sem_Literal ( Literal_Float range_ value_ ) = sem_Literal_Float ( sem_Range range_ ) value_ +sem_Literal ( Literal_String range_ value_ ) = sem_Literal_String ( sem_Range range_ ) value_ + +-- semantic domain +newtype T_Literal = T_Literal { + attach_T_Literal :: Identity (T_Literal_s86 ) + } +newtype T_Literal_s86 = C_Literal_s86 { + inv_Literal_s86 :: (T_Literal_v85 ) + } +data T_Literal_s87 = C_Literal_s87 +type T_Literal_v85 = (T_Literal_vIn85 ) -> (T_Literal_vOut85 ) +data T_Literal_vIn85 = T_Literal_vIn85 +data T_Literal_vOut85 = T_Literal_vOut85 ( Core.Expr ) (Literal) +{-# NOINLINE sem_Literal_Int #-} +sem_Literal_Int :: T_Range -> (String) -> T_Literal +sem_Literal_Int arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcore :: Core.Expr + _lhsOcore = rule392 arg_value_ + _self = rule393 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule394 _self + __result_ = T_Literal_vOut85 _lhsOcore _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule392 #-} + rule392 = \ value_ -> + Core.Lit (Core.LitInt (read value_)) + {-# INLINE rule393 #-} + rule393 = \ ((_rangeIself) :: Range) value_ -> + Literal_Int _rangeIself value_ + {-# INLINE rule394 #-} + rule394 = \ _self -> + _self +{-# NOINLINE sem_Literal_Char #-} +sem_Literal_Char :: T_Range -> (String) -> T_Literal +sem_Literal_Char arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcore :: Core.Expr + _lhsOcore = rule395 arg_value_ + _self = rule396 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule397 _self + __result_ = T_Literal_vOut85 _lhsOcore _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule395 #-} + rule395 = \ value_ -> + Core.Lit (Core.LitInt (ord + (read ("'" ++ value_ ++ "'")))) + {-# INLINE rule396 #-} + rule396 = \ ((_rangeIself) :: Range) value_ -> + Literal_Char _rangeIself value_ + {-# INLINE rule397 #-} + rule397 = \ _self -> + _self +{-# NOINLINE sem_Literal_Float #-} +sem_Literal_Float :: T_Range -> (String) -> T_Literal +sem_Literal_Float arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcore :: Core.Expr + _lhsOcore = rule398 arg_value_ + _self = rule399 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule400 _self + __result_ = T_Literal_vOut85 _lhsOcore _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule398 #-} + rule398 = \ value_ -> + float value_ + {-# INLINE rule399 #-} + rule399 = \ ((_rangeIself) :: Range) value_ -> + Literal_Float _rangeIself value_ + {-# INLINE rule400 #-} + rule400 = \ _self -> + _self +{-# NOINLINE sem_Literal_String #-} +sem_Literal_String :: T_Range -> (String) -> T_Literal +sem_Literal_String arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcore :: Core.Expr + _lhsOcore = rule401 arg_value_ + _self = rule402 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule403 _self + __result_ = T_Literal_vOut85 _lhsOcore _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule401 #-} + rule401 = \ value_ -> + var "$primPackedToString" `app_` + packedString (read ("\"" ++ value_ ++ "\"")) + {-# INLINE rule402 #-} + rule402 = \ ((_rangeIself) :: Range) value_ -> + Literal_String _rangeIself value_ + {-# INLINE rule403 #-} + rule403 = \ _self -> + _self + +-- MaybeDeclarations ------------------------------------------- +-- wrapper +data Inh_MaybeDeclarations = Inh_MaybeDeclarations { dictionaryEnv_Inh_MaybeDeclarations :: (DictionaryEnvironment) } +data Syn_MaybeDeclarations = Syn_MaybeDeclarations { core_Syn_MaybeDeclarations :: ( Core.Expr -> Core.Expr ), self_Syn_MaybeDeclarations :: (MaybeDeclarations) } +{-# INLINABLE wrap_MaybeDeclarations #-} +wrap_MaybeDeclarations :: T_MaybeDeclarations -> Inh_MaybeDeclarations -> (Syn_MaybeDeclarations ) +wrap_MaybeDeclarations (T_MaybeDeclarations act) (Inh_MaybeDeclarations _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeDeclarations_vIn88 _lhsIdictionaryEnv + (T_MaybeDeclarations_vOut88 _lhsOcore _lhsOself) <- return (inv_MaybeDeclarations_s89 sem arg) + return (Syn_MaybeDeclarations _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeDeclarations #-} +sem_MaybeDeclarations :: MaybeDeclarations -> T_MaybeDeclarations +sem_MaybeDeclarations ( MaybeDeclarations_Nothing ) = sem_MaybeDeclarations_Nothing +sem_MaybeDeclarations ( MaybeDeclarations_Just declarations_ ) = sem_MaybeDeclarations_Just ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_MaybeDeclarations = T_MaybeDeclarations { + attach_T_MaybeDeclarations :: Identity (T_MaybeDeclarations_s89 ) + } +newtype T_MaybeDeclarations_s89 = C_MaybeDeclarations_s89 { + inv_MaybeDeclarations_s89 :: (T_MaybeDeclarations_v88 ) + } +data T_MaybeDeclarations_s90 = C_MaybeDeclarations_s90 +type T_MaybeDeclarations_v88 = (T_MaybeDeclarations_vIn88 ) -> (T_MaybeDeclarations_vOut88 ) +data T_MaybeDeclarations_vIn88 = T_MaybeDeclarations_vIn88 (DictionaryEnvironment) +data T_MaybeDeclarations_vOut88 = T_MaybeDeclarations_vOut88 ( Core.Expr -> Core.Expr ) (MaybeDeclarations) +{-# NOINLINE sem_MaybeDeclarations_Nothing #-} +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 _lhsIdictionaryEnv) -> ( let + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule404 () + _self = rule405 () + _lhsOself :: MaybeDeclarations + _lhsOself = rule406 _self + __result_ = T_MaybeDeclarations_vOut88 _lhsOcore _lhsOself + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule404 #-} + rule404 = \ (_ :: ()) -> + \continue -> continue + {-# INLINE rule405 #-} + rule405 = \ (_ :: ()) -> + MaybeDeclarations_Nothing + {-# INLINE rule406 #-} + rule406 = \ _self -> + _self +{-# NOINLINE sem_MaybeDeclarations_Just #-} +sem_MaybeDeclarations_Just :: T_Declarations -> T_MaybeDeclarations +sem_MaybeDeclarations_Just arg_declarations_ = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 _lhsIdictionaryEnv) -> ( let + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Declarations_vOut31 _declarationsIdecls _declarationsIpatBindNr _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOdictionaryEnv _declarationsOimportEnv _declarationsOisTopLevel _declarationsOpatBindNr) + _importEnv = rule407 () + _declarationsOpatBindNr = rule408 () + _declarationsOisTopLevel = rule409 () + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule410 _declarationsIdecls + _self = rule411 _declarationsIself + _lhsOself :: MaybeDeclarations + _lhsOself = rule412 _self + _declarationsOdictionaryEnv = rule413 _lhsIdictionaryEnv + _declarationsOimportEnv = rule414 _importEnv + __result_ = T_MaybeDeclarations_vOut88 _lhsOcore _lhsOself + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule407 #-} + rule407 = \ (_ :: ()) -> + internalError "CodeGeneration.ag" "MaybeDeclarations.Just" "" + {-# INLINE rule408 #-} + rule408 = \ (_ :: ()) -> + 0 + {-# INLINE rule409 #-} + rule409 = \ (_ :: ()) -> + False + {-# INLINE rule410 #-} + rule410 = \ ((_declarationsIdecls) :: [CoreDecl] ) -> + \continue -> letrec_ _declarationsIdecls continue + {-# INLINE rule411 #-} + rule411 = \ ((_declarationsIself) :: Declarations) -> + MaybeDeclarations_Just _declarationsIself + {-# INLINE rule412 #-} + rule412 = \ _self -> + _self + {-# INLINE rule413 #-} + rule413 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule414 #-} + rule414 = \ _importEnv -> + _importEnv + +-- MaybeExports ------------------------------------------------ +-- wrapper +data Inh_MaybeExports = Inh_MaybeExports { } +data Syn_MaybeExports = Syn_MaybeExports { cons_Syn_MaybeExports :: (IdSet), mods_Syn_MaybeExports :: (IdSet), self_Syn_MaybeExports :: (MaybeExports), types_Syn_MaybeExports :: (IdSet), values_Syn_MaybeExports :: (IdSet) } +{-# INLINABLE wrap_MaybeExports #-} +wrap_MaybeExports :: T_MaybeExports -> Inh_MaybeExports -> (Syn_MaybeExports ) +wrap_MaybeExports (T_MaybeExports act) (Inh_MaybeExports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExports_vIn91 + (T_MaybeExports_vOut91 _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues) <- return (inv_MaybeExports_s92 sem arg) + return (Syn_MaybeExports _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues) + ) + +-- cata +{-# NOINLINE sem_MaybeExports #-} +sem_MaybeExports :: MaybeExports -> T_MaybeExports +sem_MaybeExports ( MaybeExports_Nothing ) = sem_MaybeExports_Nothing +sem_MaybeExports ( MaybeExports_Just exports_ ) = sem_MaybeExports_Just ( sem_Exports exports_ ) + +-- semantic domain +newtype T_MaybeExports = T_MaybeExports { + attach_T_MaybeExports :: Identity (T_MaybeExports_s92 ) + } +newtype T_MaybeExports_s92 = C_MaybeExports_s92 { + inv_MaybeExports_s92 :: (T_MaybeExports_v91 ) + } +data T_MaybeExports_s93 = C_MaybeExports_s93 +type T_MaybeExports_v91 = (T_MaybeExports_vIn91 ) -> (T_MaybeExports_vOut91 ) +data T_MaybeExports_vIn91 = T_MaybeExports_vIn91 +data T_MaybeExports_vOut91 = T_MaybeExports_vOut91 (IdSet) (IdSet) (MaybeExports) (IdSet) (IdSet) +{-# NOINLINE sem_MaybeExports_Nothing #-} +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _lhsOcons :: IdSet + _lhsOcons = rule415 () + _lhsOmods :: IdSet + _lhsOmods = rule416 () + _lhsOtypes :: IdSet + _lhsOtypes = rule417 () + _lhsOvalues :: IdSet + _lhsOvalues = rule418 () + _self = rule419 () + _lhsOself :: MaybeExports + _lhsOself = rule420 _self + __result_ = T_MaybeExports_vOut91 _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule415 #-} + rule415 = \ (_ :: ()) -> + emptySet + {-# INLINE rule416 #-} + rule416 = \ (_ :: ()) -> + emptySet + {-# INLINE rule417 #-} + rule417 = \ (_ :: ()) -> + emptySet + {-# INLINE rule418 #-} + rule418 = \ (_ :: ()) -> + emptySet + {-# INLINE rule419 #-} + rule419 = \ (_ :: ()) -> + MaybeExports_Nothing + {-# INLINE rule420 #-} + rule420 = \ _self -> + _self +{-# NOINLINE sem_MaybeExports_Just #-} +sem_MaybeExports_Just :: T_Exports -> T_MaybeExports +sem_MaybeExports_Just arg_exports_ = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _exportsX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_exports_)) + (T_Exports_vOut37 _exportsIcons _exportsImods _exportsIself _exportsItypes _exportsIvalues) = inv_Exports_s38 _exportsX38 (T_Exports_vIn37 ) + _lhsOcons :: IdSet + _lhsOcons = rule421 _exportsIcons + _lhsOmods :: IdSet + _lhsOmods = rule422 _exportsImods + _lhsOtypes :: IdSet + _lhsOtypes = rule423 _exportsItypes + _lhsOvalues :: IdSet + _lhsOvalues = rule424 _exportsIvalues + _self = rule425 _exportsIself + _lhsOself :: MaybeExports + _lhsOself = rule426 _self + __result_ = T_MaybeExports_vOut91 _lhsOcons _lhsOmods _lhsOself _lhsOtypes _lhsOvalues + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule421 #-} + rule421 = \ ((_exportsIcons) :: IdSet) -> + _exportsIcons + {-# INLINE rule422 #-} + rule422 = \ ((_exportsImods) :: IdSet) -> + _exportsImods + {-# INLINE rule423 #-} + rule423 = \ ((_exportsItypes) :: IdSet) -> + _exportsItypes + {-# INLINE rule424 #-} + rule424 = \ ((_exportsIvalues) :: IdSet) -> + _exportsIvalues + {-# INLINE rule425 #-} + rule425 = \ ((_exportsIself) :: Exports) -> + MaybeExports_Just _exportsIself + {-# INLINE rule426 #-} + rule426 = \ _self -> + _self + +-- MaybeExpression --------------------------------------------- +-- wrapper +data Inh_MaybeExpression = Inh_MaybeExpression { dictionaryEnv_Inh_MaybeExpression :: (DictionaryEnvironment) } +data Syn_MaybeExpression = Syn_MaybeExpression { core_Syn_MaybeExpression :: ( Maybe Core.Expr ), self_Syn_MaybeExpression :: (MaybeExpression) } +{-# INLINABLE wrap_MaybeExpression #-} +wrap_MaybeExpression :: T_MaybeExpression -> Inh_MaybeExpression -> (Syn_MaybeExpression ) +wrap_MaybeExpression (T_MaybeExpression act) (Inh_MaybeExpression _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExpression_vIn94 _lhsIdictionaryEnv + (T_MaybeExpression_vOut94 _lhsOcore _lhsOself) <- return (inv_MaybeExpression_s95 sem arg) + return (Syn_MaybeExpression _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExpression #-} +sem_MaybeExpression :: MaybeExpression -> T_MaybeExpression +sem_MaybeExpression ( MaybeExpression_Nothing ) = sem_MaybeExpression_Nothing +sem_MaybeExpression ( MaybeExpression_Just expression_ ) = sem_MaybeExpression_Just ( sem_Expression expression_ ) + +-- semantic domain +newtype T_MaybeExpression = T_MaybeExpression { + attach_T_MaybeExpression :: Identity (T_MaybeExpression_s95 ) + } +newtype T_MaybeExpression_s95 = C_MaybeExpression_s95 { + inv_MaybeExpression_s95 :: (T_MaybeExpression_v94 ) + } +data T_MaybeExpression_s96 = C_MaybeExpression_s96 +type T_MaybeExpression_v94 = (T_MaybeExpression_vIn94 ) -> (T_MaybeExpression_vOut94 ) +data T_MaybeExpression_vIn94 = T_MaybeExpression_vIn94 (DictionaryEnvironment) +data T_MaybeExpression_vOut94 = T_MaybeExpression_vOut94 ( Maybe Core.Expr ) (MaybeExpression) +{-# NOINLINE sem_MaybeExpression_Nothing #-} +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 _lhsIdictionaryEnv) -> ( let + _lhsOcore :: Maybe Core.Expr + _lhsOcore = rule427 () + _self = rule428 () + _lhsOself :: MaybeExpression + _lhsOself = rule429 _self + __result_ = T_MaybeExpression_vOut94 _lhsOcore _lhsOself + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule427 #-} + rule427 = \ (_ :: ()) -> + Nothing + {-# INLINE rule428 #-} + rule428 = \ (_ :: ()) -> + MaybeExpression_Nothing + {-# INLINE rule429 #-} + rule429 = \ _self -> + _self +{-# NOINLINE sem_MaybeExpression_Just #-} +sem_MaybeExpression_Just :: T_Expression -> T_MaybeExpression +sem_MaybeExpression_Just arg_expression_ = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 _lhsIdictionaryEnv) -> ( let + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _lhsOcore :: Maybe Core.Expr + _lhsOcore = rule430 _expressionIcore + _self = rule431 _expressionIself + _lhsOself :: MaybeExpression + _lhsOself = rule432 _self + _expressionOdictionaryEnv = rule433 _lhsIdictionaryEnv + __result_ = T_MaybeExpression_vOut94 _lhsOcore _lhsOself + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule430 #-} + rule430 = \ ((_expressionIcore) :: Core.Expr ) -> + Just _expressionIcore + {-# INLINE rule431 #-} + rule431 = \ ((_expressionIself) :: Expression) -> + MaybeExpression_Just _expressionIself + {-# INLINE rule432 #-} + rule432 = \ _self -> + _self + {-# INLINE rule433 #-} + rule433 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + +-- MaybeImportSpecification ------------------------------------ +-- wrapper +data Inh_MaybeImportSpecification = Inh_MaybeImportSpecification { } +data Syn_MaybeImportSpecification = Syn_MaybeImportSpecification { self_Syn_MaybeImportSpecification :: (MaybeImportSpecification) } +{-# INLINABLE wrap_MaybeImportSpecification #-} +wrap_MaybeImportSpecification :: T_MaybeImportSpecification -> Inh_MaybeImportSpecification -> (Syn_MaybeImportSpecification ) +wrap_MaybeImportSpecification (T_MaybeImportSpecification act) (Inh_MaybeImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeImportSpecification_vIn97 + (T_MaybeImportSpecification_vOut97 _lhsOself) <- return (inv_MaybeImportSpecification_s98 sem arg) + return (Syn_MaybeImportSpecification _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeImportSpecification #-} +sem_MaybeImportSpecification :: MaybeImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification ( MaybeImportSpecification_Nothing ) = sem_MaybeImportSpecification_Nothing +sem_MaybeImportSpecification ( MaybeImportSpecification_Just importspecification_ ) = sem_MaybeImportSpecification_Just ( sem_ImportSpecification importspecification_ ) + +-- semantic domain +newtype T_MaybeImportSpecification = T_MaybeImportSpecification { + attach_T_MaybeImportSpecification :: Identity (T_MaybeImportSpecification_s98 ) + } +newtype T_MaybeImportSpecification_s98 = C_MaybeImportSpecification_s98 { + inv_MaybeImportSpecification_s98 :: (T_MaybeImportSpecification_v97 ) + } +data T_MaybeImportSpecification_s99 = C_MaybeImportSpecification_s99 +type T_MaybeImportSpecification_v97 = (T_MaybeImportSpecification_vIn97 ) -> (T_MaybeImportSpecification_vOut97 ) +data T_MaybeImportSpecification_vIn97 = T_MaybeImportSpecification_vIn97 +data T_MaybeImportSpecification_vOut97 = T_MaybeImportSpecification_vOut97 (MaybeImportSpecification) +{-# NOINLINE sem_MaybeImportSpecification_Nothing #-} +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _self = rule434 () + _lhsOself :: MaybeImportSpecification + _lhsOself = rule435 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule434 #-} + rule434 = \ (_ :: ()) -> + MaybeImportSpecification_Nothing + {-# INLINE rule435 #-} + rule435 = \ _self -> + _self +{-# NOINLINE sem_MaybeImportSpecification_Just #-} +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification_Just arg_importspecification_ = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _importspecificationX77 = Control.Monad.Identity.runIdentity (attach_T_ImportSpecification (arg_importspecification_)) + (T_ImportSpecification_vOut76 _importspecificationIself) = inv_ImportSpecification_s77 _importspecificationX77 (T_ImportSpecification_vIn76 ) + _self = rule436 _importspecificationIself + _lhsOself :: MaybeImportSpecification + _lhsOself = rule437 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule436 #-} + rule436 = \ ((_importspecificationIself) :: ImportSpecification) -> + MaybeImportSpecification_Just _importspecificationIself + {-# INLINE rule437 #-} + rule437 = \ _self -> + _self + +-- MaybeInt ---------------------------------------------------- +-- wrapper +data Inh_MaybeInt = Inh_MaybeInt { } +data Syn_MaybeInt = Syn_MaybeInt { self_Syn_MaybeInt :: (MaybeInt) } +{-# INLINABLE wrap_MaybeInt #-} +wrap_MaybeInt :: T_MaybeInt -> Inh_MaybeInt -> (Syn_MaybeInt ) +wrap_MaybeInt (T_MaybeInt act) (Inh_MaybeInt ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeInt_vIn100 + (T_MaybeInt_vOut100 _lhsOself) <- return (inv_MaybeInt_s101 sem arg) + return (Syn_MaybeInt _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeInt #-} +sem_MaybeInt :: MaybeInt -> T_MaybeInt +sem_MaybeInt ( MaybeInt_Nothing ) = sem_MaybeInt_Nothing +sem_MaybeInt ( MaybeInt_Just int_ ) = sem_MaybeInt_Just int_ + +-- semantic domain +newtype T_MaybeInt = T_MaybeInt { + attach_T_MaybeInt :: Identity (T_MaybeInt_s101 ) + } +newtype T_MaybeInt_s101 = C_MaybeInt_s101 { + inv_MaybeInt_s101 :: (T_MaybeInt_v100 ) + } +data T_MaybeInt_s102 = C_MaybeInt_s102 +type T_MaybeInt_v100 = (T_MaybeInt_vIn100 ) -> (T_MaybeInt_vOut100 ) +data T_MaybeInt_vIn100 = T_MaybeInt_vIn100 +data T_MaybeInt_vOut100 = T_MaybeInt_vOut100 (MaybeInt) +{-# NOINLINE sem_MaybeInt_Nothing #-} +sem_MaybeInt_Nothing :: T_MaybeInt +sem_MaybeInt_Nothing = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule438 () + _lhsOself :: MaybeInt + _lhsOself = rule439 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule438 #-} + rule438 = \ (_ :: ()) -> + MaybeInt_Nothing + {-# INLINE rule439 #-} + rule439 = \ _self -> + _self +{-# NOINLINE sem_MaybeInt_Just #-} +sem_MaybeInt_Just :: (Int) -> T_MaybeInt +sem_MaybeInt_Just arg_int_ = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule440 arg_int_ + _lhsOself :: MaybeInt + _lhsOself = rule441 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule440 #-} + rule440 = \ int_ -> + MaybeInt_Just int_ + {-# INLINE rule441 #-} + rule441 = \ _self -> + _self + +-- MaybeName --------------------------------------------------- +-- wrapper +data Inh_MaybeName = Inh_MaybeName { } +data Syn_MaybeName = Syn_MaybeName { isNothing_Syn_MaybeName :: (Bool), name_Syn_MaybeName :: ( Maybe Name ), self_Syn_MaybeName :: (MaybeName) } +{-# INLINABLE wrap_MaybeName #-} +wrap_MaybeName :: T_MaybeName -> Inh_MaybeName -> (Syn_MaybeName ) +wrap_MaybeName (T_MaybeName act) (Inh_MaybeName ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeName_vIn103 + (T_MaybeName_vOut103 _lhsOisNothing _lhsOname _lhsOself) <- return (inv_MaybeName_s104 sem arg) + return (Syn_MaybeName _lhsOisNothing _lhsOname _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeName #-} +sem_MaybeName :: MaybeName -> T_MaybeName +sem_MaybeName ( MaybeName_Nothing ) = sem_MaybeName_Nothing +sem_MaybeName ( MaybeName_Just name_ ) = sem_MaybeName_Just ( sem_Name name_ ) + +-- semantic domain +newtype T_MaybeName = T_MaybeName { + attach_T_MaybeName :: Identity (T_MaybeName_s104 ) + } +newtype T_MaybeName_s104 = C_MaybeName_s104 { + inv_MaybeName_s104 :: (T_MaybeName_v103 ) + } +data T_MaybeName_s105 = C_MaybeName_s105 +type T_MaybeName_v103 = (T_MaybeName_vIn103 ) -> (T_MaybeName_vOut103 ) +data T_MaybeName_vIn103 = T_MaybeName_vIn103 +data T_MaybeName_vOut103 = T_MaybeName_vOut103 (Bool) ( Maybe Name ) (MaybeName) +{-# NOINLINE sem_MaybeName_Nothing #-} +sem_MaybeName_Nothing :: T_MaybeName +sem_MaybeName_Nothing = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _lhsOisNothing :: Bool + _lhsOisNothing = rule442 () + _lhsOname :: Maybe Name + _lhsOname = rule443 () + _self = rule444 () + _lhsOself :: MaybeName + _lhsOself = rule445 _self + __result_ = T_MaybeName_vOut103 _lhsOisNothing _lhsOname _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule442 #-} + rule442 = \ (_ :: ()) -> + True + {-# INLINE rule443 #-} + rule443 = \ (_ :: ()) -> + Nothing + {-# INLINE rule444 #-} + rule444 = \ (_ :: ()) -> + MaybeName_Nothing + {-# INLINE rule445 #-} + rule445 = \ _self -> + _self +{-# NOINLINE sem_MaybeName_Just #-} +sem_MaybeName_Just :: T_Name -> T_MaybeName +sem_MaybeName_Just arg_name_ = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOisNothing :: Bool + _lhsOisNothing = rule446 () + _lhsOname :: Maybe Name + _lhsOname = rule447 _nameIself + _self = rule448 _nameIself + _lhsOself :: MaybeName + _lhsOself = rule449 _self + __result_ = T_MaybeName_vOut103 _lhsOisNothing _lhsOname _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule446 #-} + rule446 = \ (_ :: ()) -> + False + {-# INLINE rule447 #-} + rule447 = \ ((_nameIself) :: Name) -> + Just _nameIself + {-# INLINE rule448 #-} + rule448 = \ ((_nameIself) :: Name) -> + MaybeName_Just _nameIself + {-# INLINE rule449 #-} + rule449 = \ _self -> + _self + +-- MaybeNames -------------------------------------------------- +-- wrapper +data Inh_MaybeNames = Inh_MaybeNames { } +data Syn_MaybeNames = Syn_MaybeNames { names_Syn_MaybeNames :: ( Maybe [Name] ), self_Syn_MaybeNames :: (MaybeNames) } +{-# INLINABLE wrap_MaybeNames #-} +wrap_MaybeNames :: T_MaybeNames -> Inh_MaybeNames -> (Syn_MaybeNames ) +wrap_MaybeNames (T_MaybeNames act) (Inh_MaybeNames ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeNames_vIn106 + (T_MaybeNames_vOut106 _lhsOnames _lhsOself) <- return (inv_MaybeNames_s107 sem arg) + return (Syn_MaybeNames _lhsOnames _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeNames #-} +sem_MaybeNames :: MaybeNames -> T_MaybeNames +sem_MaybeNames ( MaybeNames_Nothing ) = sem_MaybeNames_Nothing +sem_MaybeNames ( MaybeNames_Just names_ ) = sem_MaybeNames_Just ( sem_Names names_ ) + +-- semantic domain +newtype T_MaybeNames = T_MaybeNames { + attach_T_MaybeNames :: Identity (T_MaybeNames_s107 ) + } +newtype T_MaybeNames_s107 = C_MaybeNames_s107 { + inv_MaybeNames_s107 :: (T_MaybeNames_v106 ) + } +data T_MaybeNames_s108 = C_MaybeNames_s108 +type T_MaybeNames_v106 = (T_MaybeNames_vIn106 ) -> (T_MaybeNames_vOut106 ) +data T_MaybeNames_vIn106 = T_MaybeNames_vIn106 +data T_MaybeNames_vOut106 = T_MaybeNames_vOut106 ( Maybe [Name] ) (MaybeNames) +{-# NOINLINE sem_MaybeNames_Nothing #-} +sem_MaybeNames_Nothing :: T_MaybeNames +sem_MaybeNames_Nothing = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _lhsOnames :: Maybe [Name] + _lhsOnames = rule450 () + _self = rule451 () + _lhsOself :: MaybeNames + _lhsOself = rule452 _self + __result_ = T_MaybeNames_vOut106 _lhsOnames _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule450 #-} + rule450 = \ (_ :: ()) -> + Nothing + {-# INLINE rule451 #-} + rule451 = \ (_ :: ()) -> + MaybeNames_Nothing + {-# INLINE rule452 #-} + rule452 = \ _self -> + _self +{-# NOINLINE sem_MaybeNames_Just #-} +sem_MaybeNames_Just :: T_Names -> T_MaybeNames +sem_MaybeNames_Just arg_names_ = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + (T_Names_vOut115 _namesInames _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + _lhsOnames :: Maybe [Name] + _lhsOnames = rule453 _namesInames + _self = rule454 _namesIself + _lhsOself :: MaybeNames + _lhsOself = rule455 _self + __result_ = T_MaybeNames_vOut106 _lhsOnames _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule453 #-} + rule453 = \ ((_namesInames) :: [Name]) -> + Just _namesInames + {-# INLINE rule454 #-} + rule454 = \ ((_namesIself) :: Names) -> + MaybeNames_Just _namesIself + {-# INLINE rule455 #-} + rule455 = \ _self -> + _self + +-- Module ------------------------------------------------------ +-- wrapper +data Inh_Module = Inh_Module { dictionaryEnv_Inh_Module :: (DictionaryEnvironment), extraDecls_Inh_Module :: ( [Core.CoreDecl] ), importEnv_Inh_Module :: (ImportEnvironment), toplevelTypes_Inh_Module :: (TypeEnvironment) } +data Syn_Module = Syn_Module { core_Syn_Module :: ( Core.CoreModule ), self_Syn_Module :: (Module) } +{-# INLINABLE wrap_Module #-} +wrap_Module :: T_Module -> Inh_Module -> (Syn_Module ) +wrap_Module (T_Module act) (Inh_Module _lhsIdictionaryEnv _lhsIextraDecls _lhsIimportEnv _lhsItoplevelTypes) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Module_vIn109 _lhsIdictionaryEnv _lhsIextraDecls _lhsIimportEnv _lhsItoplevelTypes + (T_Module_vOut109 _lhsOcore _lhsOself) <- return (inv_Module_s110 sem arg) + return (Syn_Module _lhsOcore _lhsOself) + ) + +-- cata +{-# INLINE sem_Module #-} +sem_Module :: Module -> T_Module +sem_Module ( Module_Module range_ name_ exports_ body_ ) = sem_Module_Module ( sem_Range range_ ) ( sem_MaybeName name_ ) ( sem_MaybeExports exports_ ) ( sem_Body body_ ) + +-- semantic domain +newtype T_Module = T_Module { + attach_T_Module :: Identity (T_Module_s110 ) + } +newtype T_Module_s110 = C_Module_s110 { + inv_Module_s110 :: (T_Module_v109 ) + } +data T_Module_s111 = C_Module_s111 +type T_Module_v109 = (T_Module_vIn109 ) -> (T_Module_vOut109 ) +data T_Module_vIn109 = T_Module_vIn109 (DictionaryEnvironment) ( [Core.CoreDecl] ) (ImportEnvironment) (TypeEnvironment) +data T_Module_vOut109 = T_Module_vOut109 ( Core.CoreModule ) (Module) +{-# NOINLINE sem_Module_Module #-} +sem_Module_Module :: T_Range -> T_MaybeName -> T_MaybeExports -> T_Body -> T_Module +sem_Module_Module arg_range_ arg_name_ arg_exports_ arg_body_ = T_Module (return st110) where + {-# NOINLINE st110 #-} + st110 = let + v109 :: T_Module_v109 + v109 = \ (T_Module_vIn109 _lhsIdictionaryEnv _lhsIextraDecls _lhsIimportEnv _lhsItoplevelTypes) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_name_)) + _exportsX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeExports (arg_exports_)) + _bodyX14 = Control.Monad.Identity.runIdentity (attach_T_Body (arg_body_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeName_vOut103 _nameIisNothing _nameIname _nameIself) = inv_MaybeName_s104 _nameX104 (T_MaybeName_vIn103 ) + (T_MaybeExports_vOut91 _exportsIcons _exportsImods _exportsIself _exportsItypes _exportsIvalues) = inv_MaybeExports_s92 _exportsX92 (T_MaybeExports_vIn91 ) + (T_Body_vOut13 _bodyIdecls _bodyIself) = inv_Body_s14 _bodyX14 (T_Body_vIn13 _bodyOdictionaryEnv _bodyOimportEnv) + _lhsOcore :: Core.CoreModule + _lhsOcore = rule456 _lhsItoplevelTypes _module_ + _module_ = rule457 _bodyIdecls _lhsIextraDecls _nameIname + _self = rule458 _bodyIself _exportsIself _nameIself _rangeIself + _lhsOself :: Module + _lhsOself = rule459 _self + _bodyOdictionaryEnv = rule460 _lhsIdictionaryEnv + _bodyOimportEnv = rule461 _lhsIimportEnv + __result_ = T_Module_vOut109 _lhsOcore _lhsOself + in __result_ ) + in C_Module_s110 v109 + {-# INLINE rule456 #-} + rule456 = \ ((_lhsItoplevelTypes) :: TypeEnvironment) _module_ -> + _module_ { Module.moduleDecls = + insertedMain _lhsItoplevelTypes : Module.moduleDecls _module_ } + {-# INLINE rule457 #-} + rule457 = \ ((_bodyIdecls) :: [CoreDecl] ) ((_lhsIextraDecls) :: [Core.CoreDecl] ) ((_nameIname) :: Maybe Name ) -> + everythingPublicButPrelude + (makeCoreModule (fmap idFromName _nameIname) + ( _bodyIdecls ++ _lhsIextraDecls + )) + {-# INLINE rule458 #-} + rule458 = \ ((_bodyIself) :: Body) ((_exportsIself) :: MaybeExports) ((_nameIself) :: MaybeName) ((_rangeIself) :: Range) -> + Module_Module _rangeIself _nameIself _exportsIself _bodyIself + {-# INLINE rule459 #-} + rule459 = \ _self -> + _self + {-# INLINE rule460 #-} + rule460 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule461 #-} + rule461 = \ ((_lhsIimportEnv) :: ImportEnvironment) -> + _lhsIimportEnv + +-- Name -------------------------------------------------------- +-- wrapper +data Inh_Name = Inh_Name { } +data Syn_Name = Syn_Name { self_Syn_Name :: (Name) } +{-# INLINABLE wrap_Name #-} +wrap_Name :: T_Name -> Inh_Name -> (Syn_Name ) +wrap_Name (T_Name act) (Inh_Name ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Name_vIn112 + (T_Name_vOut112 _lhsOself) <- return (inv_Name_s113 sem arg) + return (Syn_Name _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Name #-} +sem_Name :: Name -> T_Name +sem_Name ( Name_Identifier range_ module_ name_ ) = sem_Name_Identifier ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Operator range_ module_ name_ ) = sem_Name_Operator ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Special range_ module_ name_ ) = sem_Name_Special ( sem_Range range_ ) ( sem_Strings module_ ) name_ + +-- semantic domain +newtype T_Name = T_Name { + attach_T_Name :: Identity (T_Name_s113 ) + } +newtype T_Name_s113 = C_Name_s113 { + inv_Name_s113 :: (T_Name_v112 ) + } +data T_Name_s114 = C_Name_s114 +type T_Name_v112 = (T_Name_vIn112 ) -> (T_Name_vOut112 ) +data T_Name_vIn112 = T_Name_vIn112 +data T_Name_vOut112 = T_Name_vOut112 (Name) +{-# NOINLINE sem_Name_Identifier #-} +sem_Name_Identifier :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Identifier arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule462 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule463 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule462 #-} + rule462 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Identifier _rangeIself _moduleIself name_ + {-# INLINE rule463 #-} + rule463 = \ _self -> + _self +{-# NOINLINE sem_Name_Operator #-} +sem_Name_Operator :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Operator arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule464 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule465 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule464 #-} + rule464 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Operator _rangeIself _moduleIself name_ + {-# INLINE rule465 #-} + rule465 = \ _self -> + _self +{-# NOINLINE sem_Name_Special #-} +sem_Name_Special :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Special arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule466 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule467 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule466 #-} + rule466 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Special _rangeIself _moduleIself name_ + {-# INLINE rule467 #-} + rule467 = \ _self -> + _self + +-- Names ------------------------------------------------------- +-- wrapper +data Inh_Names = Inh_Names { } +data Syn_Names = Syn_Names { names_Syn_Names :: ([Name]), self_Syn_Names :: (Names) } +{-# INLINABLE wrap_Names #-} +wrap_Names :: T_Names -> Inh_Names -> (Syn_Names ) +wrap_Names (T_Names act) (Inh_Names ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Names_vIn115 + (T_Names_vOut115 _lhsOnames _lhsOself) <- return (inv_Names_s116 sem arg) + return (Syn_Names _lhsOnames _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Names #-} +sem_Names :: Names -> T_Names +sem_Names list = Prelude.foldr sem_Names_Cons sem_Names_Nil (Prelude.map sem_Name list) + +-- semantic domain +newtype T_Names = T_Names { + attach_T_Names :: Identity (T_Names_s116 ) + } +newtype T_Names_s116 = C_Names_s116 { + inv_Names_s116 :: (T_Names_v115 ) + } +data T_Names_s117 = C_Names_s117 +type T_Names_v115 = (T_Names_vIn115 ) -> (T_Names_vOut115 ) +data T_Names_vIn115 = T_Names_vIn115 +data T_Names_vOut115 = T_Names_vOut115 ([Name]) (Names) +{-# NOINLINE sem_Names_Cons #-} +sem_Names_Cons :: T_Name -> T_Names -> T_Names +sem_Names_Cons arg_hd_ arg_tl_ = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _hdX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_hd_)) + _tlX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_tl_)) + (T_Name_vOut112 _hdIself) = inv_Name_s113 _hdX113 (T_Name_vIn112 ) + (T_Names_vOut115 _tlInames _tlIself) = inv_Names_s116 _tlX116 (T_Names_vIn115 ) + _lhsOnames :: [Name] + _lhsOnames = rule468 _hdIself _tlInames + _self = rule469 _hdIself _tlIself + _lhsOself :: Names + _lhsOself = rule470 _self + __result_ = T_Names_vOut115 _lhsOnames _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule468 #-} + rule468 = \ ((_hdIself) :: Name) ((_tlInames) :: [Name]) -> + _hdIself : _tlInames + {-# INLINE rule469 #-} + rule469 = \ ((_hdIself) :: Name) ((_tlIself) :: Names) -> + (:) _hdIself _tlIself + {-# INLINE rule470 #-} + rule470 = \ _self -> + _self +{-# NOINLINE sem_Names_Nil #-} +sem_Names_Nil :: T_Names +sem_Names_Nil = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _lhsOnames :: [Name] + _lhsOnames = rule471 () + _self = rule472 () + _lhsOself :: Names + _lhsOself = rule473 _self + __result_ = T_Names_vOut115 _lhsOnames _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule471 #-} + rule471 = \ (_ :: ()) -> + [] + {-# INLINE rule472 #-} + rule472 = \ (_ :: ()) -> + [] + {-# INLINE rule473 #-} + rule473 = \ _self -> + _self + +-- Pattern ----------------------------------------------------- +-- wrapper +data Inh_Pattern = Inh_Pattern { } +data Syn_Pattern = Syn_Pattern { self_Syn_Pattern :: (Pattern), vars_Syn_Pattern :: ( [Name] ) } +{-# INLINABLE wrap_Pattern #-} +wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) +wrap_Pattern (T_Pattern act) (Inh_Pattern ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Pattern_vIn118 + (T_Pattern_vOut118 _lhsOself _lhsOvars) <- return (inv_Pattern_s119 sem arg) + return (Syn_Pattern _lhsOself _lhsOvars) + ) + +-- cata +{-# NOINLINE sem_Pattern #-} +sem_Pattern :: Pattern -> T_Pattern +sem_Pattern ( Pattern_Hole range_ id_ ) = sem_Pattern_Hole ( sem_Range range_ ) id_ +sem_Pattern ( Pattern_Literal range_ literal_ ) = sem_Pattern_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_Variable range_ name_ ) = sem_Pattern_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Pattern ( Pattern_Constructor range_ name_ patterns_ ) = sem_Pattern_Constructor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Parenthesized range_ pattern_ ) = sem_Pattern_Parenthesized ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ ) = sem_Pattern_InfixConstructor ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name constructorOperator_ ) ( sem_Pattern rightPattern_ ) +sem_Pattern ( Pattern_List range_ patterns_ ) = sem_Pattern_List ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Tuple range_ patterns_ ) = sem_Pattern_Tuple ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Record range_ name_ recordPatternBindings_ ) = sem_Pattern_Record ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordPatternBindings recordPatternBindings_ ) +sem_Pattern ( Pattern_Negate range_ literal_ ) = sem_Pattern_Negate ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_As range_ name_ pattern_ ) = sem_Pattern_As ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Wildcard range_ ) = sem_Pattern_Wildcard ( sem_Range range_ ) +sem_Pattern ( Pattern_Irrefutable range_ pattern_ ) = sem_Pattern_Irrefutable ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Successor range_ name_ literal_ ) = sem_Pattern_Successor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_NegateFloat range_ literal_ ) = sem_Pattern_NegateFloat ( sem_Range range_ ) ( sem_Literal literal_ ) + +-- semantic domain +newtype T_Pattern = T_Pattern { + attach_T_Pattern :: Identity (T_Pattern_s119 ) + } +newtype T_Pattern_s119 = C_Pattern_s119 { + inv_Pattern_s119 :: (T_Pattern_v118 ) + } +data T_Pattern_s120 = C_Pattern_s120 +type T_Pattern_v118 = (T_Pattern_vIn118 ) -> (T_Pattern_vOut118 ) +data T_Pattern_vIn118 = T_Pattern_vIn118 +data T_Pattern_vOut118 = T_Pattern_vOut118 (Pattern) ( [Name] ) +{-# NOINLINE sem_Pattern_Hole #-} +sem_Pattern_Hole :: T_Range -> (Integer) -> T_Pattern +sem_Pattern_Hole arg_range_ arg_id_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOvars :: [Name] + _lhsOvars = rule474 () + _self = rule475 _rangeIself arg_id_ + _lhsOself :: Pattern + _lhsOself = rule476 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule474 #-} + rule474 = \ (_ :: ()) -> + [] + {-# INLINE rule475 #-} + rule475 = \ ((_rangeIself) :: Range) id_ -> + Pattern_Hole _rangeIself id_ + {-# INLINE rule476 #-} + rule476 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Literal #-} +sem_Pattern_Literal :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Literal arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIcore _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _lhsOvars :: [Name] + _lhsOvars = rule477 () + _self = rule478 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule479 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule477 #-} + rule477 = \ (_ :: ()) -> + [] + {-# INLINE rule478 #-} + rule478 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Literal _rangeIself _literalIself + {-# INLINE rule479 #-} + rule479 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Variable #-} +sem_Pattern_Variable :: T_Range -> T_Name -> T_Pattern +sem_Pattern_Variable arg_range_ arg_name_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOvars :: [Name] + _lhsOvars = rule480 _nameIself + _self = rule481 _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule482 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule480 #-} + rule480 = \ ((_nameIself) :: Name) -> + [ _nameIself ] + {-# INLINE rule481 #-} + rule481 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Variable _rangeIself _nameIself + {-# INLINE rule482 #-} + rule482 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Constructor #-} +sem_Pattern_Constructor :: T_Range -> T_Name -> T_Patterns -> T_Pattern +sem_Pattern_Constructor arg_range_ arg_name_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIlength _patternsIself _patternsIvars) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _lhsOvars :: [Name] + _lhsOvars = rule483 _patternsIvars + _self = rule484 _nameIself _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule485 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule483 #-} + rule483 = \ ((_patternsIvars) :: [Name] ) -> + _patternsIvars + {-# INLINE rule484 #-} + rule484 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Constructor _rangeIself _nameIself _patternsIself + {-# INLINE rule485 #-} + rule485 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Parenthesized #-} +sem_Pattern_Parenthesized :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Parenthesized arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself _patternIvars) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _lhsOvars :: [Name] + _lhsOvars = rule486 _patternIvars + _self = rule487 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule488 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule486 #-} + rule486 = \ ((_patternIvars) :: [Name] ) -> + _patternIvars + {-# INLINE rule487 #-} + rule487 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Parenthesized _rangeIself _patternIself + {-# INLINE rule488 #-} + rule488 = \ _self -> + _self +{-# NOINLINE sem_Pattern_InfixConstructor #-} +sem_Pattern_InfixConstructor :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_InfixConstructor arg_range_ arg_leftPattern_ arg_constructorOperator_ arg_rightPattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIself _leftPatternIvars) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 ) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIself _rightPatternIvars) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 ) + _lhsOvars :: [Name] + _lhsOvars = rule489 _leftPatternIvars _rightPatternIvars + _self = rule490 _constructorOperatorIself _leftPatternIself _rangeIself _rightPatternIself + _lhsOself :: Pattern + _lhsOself = rule491 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule489 #-} + rule489 = \ ((_leftPatternIvars) :: [Name] ) ((_rightPatternIvars) :: [Name] ) -> + _leftPatternIvars ++ _rightPatternIvars + {-# INLINE rule490 #-} + rule490 = \ ((_constructorOperatorIself) :: Name) ((_leftPatternIself) :: Pattern) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + Pattern_InfixConstructor _rangeIself _leftPatternIself _constructorOperatorIself _rightPatternIself + {-# INLINE rule491 #-} + rule491 = \ _self -> + _self +{-# NOINLINE sem_Pattern_List #-} +sem_Pattern_List :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_List arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIlength _patternsIself _patternsIvars) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _lhsOvars :: [Name] + _lhsOvars = rule492 _patternsIvars + _self = rule493 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule494 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule492 #-} + rule492 = \ ((_patternsIvars) :: [Name] ) -> + _patternsIvars + {-# INLINE rule493 #-} + rule493 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_List _rangeIself _patternsIself + {-# INLINE rule494 #-} + rule494 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Tuple #-} +sem_Pattern_Tuple :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_Tuple arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIlength _patternsIself _patternsIvars) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _lhsOvars :: [Name] + _lhsOvars = rule495 _patternsIvars + _self = rule496 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule497 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule495 #-} + rule495 = \ ((_patternsIvars) :: [Name] ) -> + _patternsIvars + {-# INLINE rule496 #-} + rule496 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Tuple _rangeIself _patternsIself + {-# INLINE rule497 #-} + rule497 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Record #-} +sem_Pattern_Record :: T_Range -> T_Name -> T_RecordPatternBindings -> T_Pattern +sem_Pattern_Record arg_range_ arg_name_ arg_recordPatternBindings_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordPatternBindingsX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_recordPatternBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordPatternBindings_vOut145 _recordPatternBindingsIself) = inv_RecordPatternBindings_s146 _recordPatternBindingsX146 (T_RecordPatternBindings_vIn145 ) + _lhsOvars :: [Name] + _lhsOvars = rule498 () + _self = rule499 _nameIself _rangeIself _recordPatternBindingsIself + _lhsOself :: Pattern + _lhsOself = rule500 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule498 #-} + rule498 = \ (_ :: ()) -> + [] + {-# INLINE rule499 #-} + rule499 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordPatternBindingsIself) :: RecordPatternBindings) -> + Pattern_Record _rangeIself _nameIself _recordPatternBindingsIself + {-# INLINE rule500 #-} + rule500 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Negate #-} +sem_Pattern_Negate :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Negate arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIcore _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _lhsOvars :: [Name] + _lhsOvars = rule501 () + _self = rule502 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule503 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule501 #-} + rule501 = \ (_ :: ()) -> + [] + {-# INLINE rule502 #-} + rule502 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Negate _rangeIself _literalIself + {-# INLINE rule503 #-} + rule503 = \ _self -> + _self +{-# NOINLINE sem_Pattern_As #-} +sem_Pattern_As :: T_Range -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_As arg_range_ arg_name_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIself _patternIvars) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _lhsOvars :: [Name] + _lhsOvars = rule504 _nameIself _patternIvars + _self = rule505 _nameIself _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule506 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule504 #-} + rule504 = \ ((_nameIself) :: Name) ((_patternIvars) :: [Name] ) -> + _nameIself : _patternIvars + {-# INLINE rule505 #-} + rule505 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_As _rangeIself _nameIself _patternIself + {-# INLINE rule506 #-} + rule506 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Wildcard #-} +sem_Pattern_Wildcard :: T_Range -> T_Pattern +sem_Pattern_Wildcard arg_range_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOvars :: [Name] + _lhsOvars = rule507 () + _self = rule508 _rangeIself + _lhsOself :: Pattern + _lhsOself = rule509 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule507 #-} + rule507 = \ (_ :: ()) -> + [] + {-# INLINE rule508 #-} + rule508 = \ ((_rangeIself) :: Range) -> + Pattern_Wildcard _rangeIself + {-# INLINE rule509 #-} + rule509 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Irrefutable #-} +sem_Pattern_Irrefutable :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Irrefutable arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself _patternIvars) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _lhsOvars :: [Name] + _lhsOvars = rule510 _patternIvars + _self = rule511 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule512 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule510 #-} + rule510 = \ ((_patternIvars) :: [Name] ) -> + _patternIvars + {-# INLINE rule511 #-} + rule511 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Irrefutable _rangeIself _patternIself + {-# INLINE rule512 #-} + rule512 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Successor #-} +sem_Pattern_Successor :: T_Range -> T_Name -> T_Literal -> T_Pattern +sem_Pattern_Successor arg_range_ arg_name_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Literal_vOut85 _literalIcore _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _lhsOvars :: [Name] + _lhsOvars = rule513 () + _self = rule514 _literalIself _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule515 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule513 #-} + rule513 = \ (_ :: ()) -> + [] + {-# INLINE rule514 #-} + rule514 = \ ((_literalIself) :: Literal) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Successor _rangeIself _nameIself _literalIself + {-# INLINE rule515 #-} + rule515 = \ _self -> + _self +{-# NOINLINE sem_Pattern_NegateFloat #-} +sem_Pattern_NegateFloat :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_NegateFloat arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIcore _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _lhsOvars :: [Name] + _lhsOvars = rule516 () + _self = rule517 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule518 _self + __result_ = T_Pattern_vOut118 _lhsOself _lhsOvars + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule516 #-} + rule516 = \ (_ :: ()) -> + [] + {-# INLINE rule517 #-} + rule517 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_NegateFloat _rangeIself _literalIself + {-# INLINE rule518 #-} + rule518 = \ _self -> + _self + +-- Patterns ---------------------------------------------------- +-- wrapper +data Inh_Patterns = Inh_Patterns { } +data Syn_Patterns = Syn_Patterns { length_Syn_Patterns :: (Int), self_Syn_Patterns :: (Patterns), vars_Syn_Patterns :: ( [Name] ) } +{-# INLINABLE wrap_Patterns #-} +wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) +wrap_Patterns (T_Patterns act) (Inh_Patterns ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Patterns_vIn121 + (T_Patterns_vOut121 _lhsOlength _lhsOself _lhsOvars) <- return (inv_Patterns_s122 sem arg) + return (Syn_Patterns _lhsOlength _lhsOself _lhsOvars) + ) + +-- cata +{-# NOINLINE sem_Patterns #-} +sem_Patterns :: Patterns -> T_Patterns +sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) + +-- semantic domain +newtype T_Patterns = T_Patterns { + attach_T_Patterns :: Identity (T_Patterns_s122 ) + } +newtype T_Patterns_s122 = C_Patterns_s122 { + inv_Patterns_s122 :: (T_Patterns_v121 ) + } +data T_Patterns_s123 = C_Patterns_s123 +type T_Patterns_v121 = (T_Patterns_vIn121 ) -> (T_Patterns_vOut121 ) +data T_Patterns_vIn121 = T_Patterns_vIn121 +data T_Patterns_vOut121 = T_Patterns_vOut121 (Int) (Patterns) ( [Name] ) +{-# NOINLINE sem_Patterns_Cons #-} +sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns +sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 ) -> ( let + _hdX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) + _tlX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) + (T_Pattern_vOut118 _hdIself _hdIvars) = inv_Pattern_s119 _hdX119 (T_Pattern_vIn118 ) + (T_Patterns_vOut121 _tlIlength _tlIself _tlIvars) = inv_Patterns_s122 _tlX122 (T_Patterns_vIn121 ) + _lhsOlength :: Int + _lhsOlength = rule519 _tlIlength + _lhsOvars :: [Name] + _lhsOvars = rule520 _hdIvars _tlIvars + _self = rule521 _hdIself _tlIself + _lhsOself :: Patterns + _lhsOself = rule522 _self + __result_ = T_Patterns_vOut121 _lhsOlength _lhsOself _lhsOvars + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule519 #-} + rule519 = \ ((_tlIlength) :: Int) -> + 1 + _tlIlength + {-# INLINE rule520 #-} + rule520 = \ ((_hdIvars) :: [Name] ) ((_tlIvars) :: [Name] ) -> + _hdIvars ++ _tlIvars + {-# INLINE rule521 #-} + rule521 = \ ((_hdIself) :: Pattern) ((_tlIself) :: Patterns) -> + (:) _hdIself _tlIself + {-# INLINE rule522 #-} + rule522 = \ _self -> + _self +{-# NOINLINE sem_Patterns_Nil #-} +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 ) -> ( let + _lhsOlength :: Int + _lhsOlength = rule523 () + _lhsOvars :: [Name] + _lhsOvars = rule524 () + _self = rule525 () + _lhsOself :: Patterns + _lhsOself = rule526 _self + __result_ = T_Patterns_vOut121 _lhsOlength _lhsOself _lhsOvars + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule523 #-} + rule523 = \ (_ :: ()) -> + 0 + {-# INLINE rule524 #-} + rule524 = \ (_ :: ()) -> + [] + {-# INLINE rule525 #-} + rule525 = \ (_ :: ()) -> + [] + {-# INLINE rule526 #-} + rule526 = \ _self -> + _self + +-- Position ---------------------------------------------------- +-- wrapper +data Inh_Position = Inh_Position { } +data Syn_Position = Syn_Position { self_Syn_Position :: (Position) } +{-# INLINABLE wrap_Position #-} +wrap_Position :: T_Position -> Inh_Position -> (Syn_Position ) +wrap_Position (T_Position act) (Inh_Position ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Position_vIn124 + (T_Position_vOut124 _lhsOself) <- return (inv_Position_s125 sem arg) + return (Syn_Position _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Position #-} +sem_Position :: Position -> T_Position +sem_Position ( Position_Position filename_ line_ column_ ) = sem_Position_Position filename_ line_ column_ +sem_Position ( Position_Unknown ) = sem_Position_Unknown + +-- semantic domain +newtype T_Position = T_Position { + attach_T_Position :: Identity (T_Position_s125 ) + } +newtype T_Position_s125 = C_Position_s125 { + inv_Position_s125 :: (T_Position_v124 ) + } +data T_Position_s126 = C_Position_s126 +type T_Position_v124 = (T_Position_vIn124 ) -> (T_Position_vOut124 ) +data T_Position_vIn124 = T_Position_vIn124 +data T_Position_vOut124 = T_Position_vOut124 (Position) +{-# NOINLINE sem_Position_Position #-} +sem_Position_Position :: (String) -> (Int) -> (Int) -> T_Position +sem_Position_Position arg_filename_ arg_line_ arg_column_ = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule527 arg_column_ arg_filename_ arg_line_ + _lhsOself :: Position + _lhsOself = rule528 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule527 #-} + rule527 = \ column_ filename_ line_ -> + Position_Position filename_ line_ column_ + {-# INLINE rule528 #-} + rule528 = \ _self -> + _self +{-# NOINLINE sem_Position_Unknown #-} +sem_Position_Unknown :: T_Position +sem_Position_Unknown = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule529 () + _lhsOself :: Position + _lhsOself = rule530 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule529 #-} + rule529 = \ (_ :: ()) -> + Position_Unknown + {-# INLINE rule530 #-} + rule530 = \ _self -> + _self + +-- Qualifier --------------------------------------------------- +-- wrapper +data Inh_Qualifier = Inh_Qualifier { dictionaryEnv_Inh_Qualifier :: (DictionaryEnvironment) } +data Syn_Qualifier = Syn_Qualifier { core_Syn_Qualifier :: ( Core.Expr -> Core.Expr ), self_Syn_Qualifier :: (Qualifier) } +{-# INLINABLE wrap_Qualifier #-} +wrap_Qualifier :: T_Qualifier -> Inh_Qualifier -> (Syn_Qualifier ) +wrap_Qualifier (T_Qualifier act) (Inh_Qualifier _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifier_vIn127 _lhsIdictionaryEnv + (T_Qualifier_vOut127 _lhsOcore _lhsOself) <- return (inv_Qualifier_s128 sem arg) + return (Syn_Qualifier _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifier #-} +sem_Qualifier :: Qualifier -> T_Qualifier +sem_Qualifier ( Qualifier_Guard range_ guard_ ) = sem_Qualifier_Guard ( sem_Range range_ ) ( sem_Expression guard_ ) +sem_Qualifier ( Qualifier_Let range_ declarations_ ) = sem_Qualifier_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Qualifier ( Qualifier_Generator range_ pattern_ expression_ ) = sem_Qualifier_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Qualifier ( Qualifier_Empty range_ ) = sem_Qualifier_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Qualifier = T_Qualifier { + attach_T_Qualifier :: Identity (T_Qualifier_s128 ) + } +newtype T_Qualifier_s128 = C_Qualifier_s128 { + inv_Qualifier_s128 :: (T_Qualifier_v127 ) + } +data T_Qualifier_s129 = C_Qualifier_s129 +type T_Qualifier_v127 = (T_Qualifier_vIn127 ) -> (T_Qualifier_vOut127 ) +data T_Qualifier_vIn127 = T_Qualifier_vIn127 (DictionaryEnvironment) +data T_Qualifier_vOut127 = T_Qualifier_vOut127 ( Core.Expr -> Core.Expr ) (Qualifier) +{-# NOINLINE sem_Qualifier_Guard #-} +sem_Qualifier_Guard :: T_Range -> T_Expression -> T_Qualifier +sem_Qualifier_Guard arg_range_ arg_guard_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIcore _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 _guardOdictionaryEnv) + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule531 _guardIcore + _self = rule532 _guardIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule533 _self + _guardOdictionaryEnv = rule534 _lhsIdictionaryEnv + __result_ = T_Qualifier_vOut127 _lhsOcore _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule531 #-} + rule531 = \ ((_guardIcore) :: Core.Expr ) -> + \continue -> if_ _guardIcore continue nil + {-# INLINE rule532 #-} + rule532 = \ ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + Qualifier_Guard _rangeIself _guardIself + {-# INLINE rule533 #-} + rule533 = \ _self -> + _self + {-# INLINE rule534 #-} + rule534 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Qualifier_Let #-} +sem_Qualifier_Let :: T_Range -> T_Declarations -> T_Qualifier +sem_Qualifier_Let arg_range_ arg_declarations_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIdecls _declarationsIpatBindNr _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOdictionaryEnv _declarationsOimportEnv _declarationsOisTopLevel _declarationsOpatBindNr) + _importEnv = rule535 () + _declarationsOpatBindNr = rule536 () + _declarationsOisTopLevel = rule537 () + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule538 _declarationsIdecls + _self = rule539 _declarationsIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule540 _self + _declarationsOdictionaryEnv = rule541 _lhsIdictionaryEnv + _declarationsOimportEnv = rule542 _importEnv + __result_ = T_Qualifier_vOut127 _lhsOcore _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule535 #-} + rule535 = \ (_ :: ()) -> + internalError "CodeGeneration.ag" "Qualifier.Let" "" + {-# INLINE rule536 #-} + rule536 = \ (_ :: ()) -> + 0 + {-# INLINE rule537 #-} + rule537 = \ (_ :: ()) -> + False + {-# INLINE rule538 #-} + rule538 = \ ((_declarationsIdecls) :: [CoreDecl] ) -> + \continue -> letrec_ _declarationsIdecls continue + {-# INLINE rule539 #-} + rule539 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Qualifier_Let _rangeIself _declarationsIself + {-# INLINE rule540 #-} + rule540 = \ _self -> + _self + {-# INLINE rule541 #-} + rule541 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule542 #-} + rule542 = \ _importEnv -> + _importEnv +{-# NOINLINE sem_Qualifier_Generator #-} +sem_Qualifier_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Qualifier +sem_Qualifier_Generator arg_range_ arg_pattern_ arg_expression_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself _patternIvars) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule543 _expressionIcore _patternIself + _self = rule544 _expressionIself _patternIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule545 _self + _expressionOdictionaryEnv = rule546 _lhsIdictionaryEnv + __result_ = T_Qualifier_vOut127 _lhsOcore _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule543 #-} + rule543 = \ ((_expressionIcore) :: Core.Expr ) ((_patternIself) :: Pattern) -> + \continue -> + let_ nextClauseId nil + (let_ + okId + (Core.Lam parameterId + (patternToCore (parameterId, _patternIself) continue) + ) + (var "$primConcatMap" + `app_` Core.Var okId + `app_` _expressionIcore + ) + ) + {-# INLINE rule544 #-} + rule544 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Qualifier_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule545 #-} + rule545 = \ _self -> + _self + {-# INLINE rule546 #-} + rule546 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Qualifier_Empty #-} +sem_Qualifier_Empty :: T_Range -> T_Qualifier +sem_Qualifier_Empty arg_range_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcore :: Core.Expr -> Core.Expr + _lhsOcore = rule547 () + _self = rule548 _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule549 _self + __result_ = T_Qualifier_vOut127 _lhsOcore _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule547 #-} + rule547 = \ (_ :: ()) -> + internalError "ToCoreExpr" "Qualifier" "empty qualifiers not supported" + {-# INLINE rule548 #-} + rule548 = \ ((_rangeIself) :: Range) -> + Qualifier_Empty _rangeIself + {-# INLINE rule549 #-} + rule549 = \ _self -> + _self + +-- Qualifiers -------------------------------------------------- +-- wrapper +data Inh_Qualifiers = Inh_Qualifiers { dictionaryEnv_Inh_Qualifiers :: (DictionaryEnvironment) } +data Syn_Qualifiers = Syn_Qualifiers { core_Syn_Qualifiers :: ( [Core.Expr -> Core.Expr] ), self_Syn_Qualifiers :: (Qualifiers) } +{-# INLINABLE wrap_Qualifiers #-} +wrap_Qualifiers :: T_Qualifiers -> Inh_Qualifiers -> (Syn_Qualifiers ) +wrap_Qualifiers (T_Qualifiers act) (Inh_Qualifiers _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifiers_vIn130 _lhsIdictionaryEnv + (T_Qualifiers_vOut130 _lhsOcore _lhsOself) <- return (inv_Qualifiers_s131 sem arg) + return (Syn_Qualifiers _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifiers #-} +sem_Qualifiers :: Qualifiers -> T_Qualifiers +sem_Qualifiers list = Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list) + +-- semantic domain +newtype T_Qualifiers = T_Qualifiers { + attach_T_Qualifiers :: Identity (T_Qualifiers_s131 ) + } +newtype T_Qualifiers_s131 = C_Qualifiers_s131 { + inv_Qualifiers_s131 :: (T_Qualifiers_v130 ) + } +data T_Qualifiers_s132 = C_Qualifiers_s132 +type T_Qualifiers_v130 = (T_Qualifiers_vIn130 ) -> (T_Qualifiers_vOut130 ) +data T_Qualifiers_vIn130 = T_Qualifiers_vIn130 (DictionaryEnvironment) +data T_Qualifiers_vOut130 = T_Qualifiers_vOut130 ( [Core.Expr -> Core.Expr] ) (Qualifiers) +{-# NOINLINE sem_Qualifiers_Cons #-} +sem_Qualifiers_Cons :: T_Qualifier -> T_Qualifiers -> T_Qualifiers +sem_Qualifiers_Cons arg_hd_ arg_tl_ = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 _lhsIdictionaryEnv) -> ( let + _hdX128 = Control.Monad.Identity.runIdentity (attach_T_Qualifier (arg_hd_)) + _tlX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_tl_)) + (T_Qualifier_vOut127 _hdIcore _hdIself) = inv_Qualifier_s128 _hdX128 (T_Qualifier_vIn127 _hdOdictionaryEnv) + (T_Qualifiers_vOut130 _tlIcore _tlIself) = inv_Qualifiers_s131 _tlX131 (T_Qualifiers_vIn130 _tlOdictionaryEnv) + _lhsOcore :: [Core.Expr -> Core.Expr] + _lhsOcore = rule550 _hdIcore _tlIcore + _self = rule551 _hdIself _tlIself + _lhsOself :: Qualifiers + _lhsOself = rule552 _self + _hdOdictionaryEnv = rule553 _lhsIdictionaryEnv + _tlOdictionaryEnv = rule554 _lhsIdictionaryEnv + __result_ = T_Qualifiers_vOut130 _lhsOcore _lhsOself + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule550 #-} + rule550 = \ ((_hdIcore) :: Core.Expr -> Core.Expr ) ((_tlIcore) :: [Core.Expr -> Core.Expr] ) -> + _hdIcore : _tlIcore + {-# INLINE rule551 #-} + rule551 = \ ((_hdIself) :: Qualifier) ((_tlIself) :: Qualifiers) -> + (:) _hdIself _tlIself + {-# INLINE rule552 #-} + rule552 = \ _self -> + _self + {-# INLINE rule553 #-} + rule553 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule554 #-} + rule554 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Qualifiers_Nil #-} +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 _lhsIdictionaryEnv) -> ( let + _lhsOcore :: [Core.Expr -> Core.Expr] + _lhsOcore = rule555 () + _self = rule556 () + _lhsOself :: Qualifiers + _lhsOself = rule557 _self + __result_ = T_Qualifiers_vOut130 _lhsOcore _lhsOself + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule555 #-} + rule555 = \ (_ :: ()) -> + [] + {-# INLINE rule556 #-} + rule556 = \ (_ :: ()) -> + [] + {-# INLINE rule557 #-} + rule557 = \ _self -> + _self + +-- Range ------------------------------------------------------- +-- wrapper +data Inh_Range = Inh_Range { } +data Syn_Range = Syn_Range { self_Syn_Range :: (Range) } +{-# INLINABLE wrap_Range #-} +wrap_Range :: T_Range -> Inh_Range -> (Syn_Range ) +wrap_Range (T_Range act) (Inh_Range ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Range_vIn133 + (T_Range_vOut133 _lhsOself) <- return (inv_Range_s134 sem arg) + return (Syn_Range _lhsOself) + ) + +-- cata +{-# INLINE sem_Range #-} +sem_Range :: Range -> T_Range +sem_Range ( Range_Range start_ stop_ ) = sem_Range_Range ( sem_Position start_ ) ( sem_Position stop_ ) + +-- semantic domain +newtype T_Range = T_Range { + attach_T_Range :: Identity (T_Range_s134 ) + } +newtype T_Range_s134 = C_Range_s134 { + inv_Range_s134 :: (T_Range_v133 ) + } +data T_Range_s135 = C_Range_s135 +type T_Range_v133 = (T_Range_vIn133 ) -> (T_Range_vOut133 ) +data T_Range_vIn133 = T_Range_vIn133 +data T_Range_vOut133 = T_Range_vOut133 (Range) +{-# NOINLINE sem_Range_Range #-} +sem_Range_Range :: T_Position -> T_Position -> T_Range +sem_Range_Range arg_start_ arg_stop_ = T_Range (return st134) where + {-# NOINLINE st134 #-} + st134 = let + v133 :: T_Range_v133 + v133 = \ (T_Range_vIn133 ) -> ( let + _startX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_start_)) + _stopX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_stop_)) + (T_Position_vOut124 _startIself) = inv_Position_s125 _startX125 (T_Position_vIn124 ) + (T_Position_vOut124 _stopIself) = inv_Position_s125 _stopX125 (T_Position_vIn124 ) + _self = rule558 _startIself _stopIself + _lhsOself :: Range + _lhsOself = rule559 _self + __result_ = T_Range_vOut133 _lhsOself + in __result_ ) + in C_Range_s134 v133 + {-# INLINE rule558 #-} + rule558 = \ ((_startIself) :: Position) ((_stopIself) :: Position) -> + Range_Range _startIself _stopIself + {-# INLINE rule559 #-} + rule559 = \ _self -> + _self + +-- RecordExpressionBinding ------------------------------------- +-- wrapper +data Inh_RecordExpressionBinding = Inh_RecordExpressionBinding { dictionaryEnv_Inh_RecordExpressionBinding :: (DictionaryEnvironment) } +data Syn_RecordExpressionBinding = Syn_RecordExpressionBinding { self_Syn_RecordExpressionBinding :: (RecordExpressionBinding) } +{-# INLINABLE wrap_RecordExpressionBinding #-} +wrap_RecordExpressionBinding :: T_RecordExpressionBinding -> Inh_RecordExpressionBinding -> (Syn_RecordExpressionBinding ) +wrap_RecordExpressionBinding (T_RecordExpressionBinding act) (Inh_RecordExpressionBinding _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBinding_vIn136 _lhsIdictionaryEnv + (T_RecordExpressionBinding_vOut136 _lhsOself) <- return (inv_RecordExpressionBinding_s137 sem arg) + return (Syn_RecordExpressionBinding _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBinding #-} +sem_RecordExpressionBinding :: RecordExpressionBinding -> T_RecordExpressionBinding +sem_RecordExpressionBinding ( RecordExpressionBinding_RecordExpressionBinding range_ name_ expression_ ) = sem_RecordExpressionBinding_RecordExpressionBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_RecordExpressionBinding = T_RecordExpressionBinding { + attach_T_RecordExpressionBinding :: Identity (T_RecordExpressionBinding_s137 ) + } +newtype T_RecordExpressionBinding_s137 = C_RecordExpressionBinding_s137 { + inv_RecordExpressionBinding_s137 :: (T_RecordExpressionBinding_v136 ) + } +data T_RecordExpressionBinding_s138 = C_RecordExpressionBinding_s138 +type T_RecordExpressionBinding_v136 = (T_RecordExpressionBinding_vIn136 ) -> (T_RecordExpressionBinding_vOut136 ) +data T_RecordExpressionBinding_vIn136 = T_RecordExpressionBinding_vIn136 (DictionaryEnvironment) +data T_RecordExpressionBinding_vOut136 = T_RecordExpressionBinding_vOut136 (RecordExpressionBinding) +{-# NOINLINE sem_RecordExpressionBinding_RecordExpressionBinding #-} +sem_RecordExpressionBinding_RecordExpressionBinding :: T_Range -> T_Name -> T_Expression -> T_RecordExpressionBinding +sem_RecordExpressionBinding_RecordExpressionBinding arg_range_ arg_name_ arg_expression_ = T_RecordExpressionBinding (return st137) where + {-# NOINLINE st137 #-} + st137 = let + v136 :: T_RecordExpressionBinding_v136 + v136 = \ (T_RecordExpressionBinding_vIn136 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _self = rule560 _expressionIself _nameIself _rangeIself + _lhsOself :: RecordExpressionBinding + _lhsOself = rule561 _self + _expressionOdictionaryEnv = rule562 _lhsIdictionaryEnv + __result_ = T_RecordExpressionBinding_vOut136 _lhsOself + in __result_ ) + in C_RecordExpressionBinding_s137 v136 + {-# INLINE rule560 #-} + rule560 = \ ((_expressionIself) :: Expression) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + RecordExpressionBinding_RecordExpressionBinding _rangeIself _nameIself _expressionIself + {-# INLINE rule561 #-} + rule561 = \ _self -> + _self + {-# INLINE rule562 #-} + rule562 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + +-- RecordExpressionBindings ------------------------------------ +-- wrapper +data Inh_RecordExpressionBindings = Inh_RecordExpressionBindings { dictionaryEnv_Inh_RecordExpressionBindings :: (DictionaryEnvironment) } +data Syn_RecordExpressionBindings = Syn_RecordExpressionBindings { self_Syn_RecordExpressionBindings :: (RecordExpressionBindings) } +{-# INLINABLE wrap_RecordExpressionBindings #-} +wrap_RecordExpressionBindings :: T_RecordExpressionBindings -> Inh_RecordExpressionBindings -> (Syn_RecordExpressionBindings ) +wrap_RecordExpressionBindings (T_RecordExpressionBindings act) (Inh_RecordExpressionBindings _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBindings_vIn139 _lhsIdictionaryEnv + (T_RecordExpressionBindings_vOut139 _lhsOself) <- return (inv_RecordExpressionBindings_s140 sem arg) + return (Syn_RecordExpressionBindings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBindings #-} +sem_RecordExpressionBindings :: RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings list = Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list) + +-- semantic domain +newtype T_RecordExpressionBindings = T_RecordExpressionBindings { + attach_T_RecordExpressionBindings :: Identity (T_RecordExpressionBindings_s140 ) + } +newtype T_RecordExpressionBindings_s140 = C_RecordExpressionBindings_s140 { + inv_RecordExpressionBindings_s140 :: (T_RecordExpressionBindings_v139 ) + } +data T_RecordExpressionBindings_s141 = C_RecordExpressionBindings_s141 +type T_RecordExpressionBindings_v139 = (T_RecordExpressionBindings_vIn139 ) -> (T_RecordExpressionBindings_vOut139 ) +data T_RecordExpressionBindings_vIn139 = T_RecordExpressionBindings_vIn139 (DictionaryEnvironment) +data T_RecordExpressionBindings_vOut139 = T_RecordExpressionBindings_vOut139 (RecordExpressionBindings) +{-# NOINLINE sem_RecordExpressionBindings_Cons #-} +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> T_RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons arg_hd_ arg_tl_ = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 _lhsIdictionaryEnv) -> ( let + _hdX137 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBinding (arg_hd_)) + _tlX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_tl_)) + (T_RecordExpressionBinding_vOut136 _hdIself) = inv_RecordExpressionBinding_s137 _hdX137 (T_RecordExpressionBinding_vIn136 _hdOdictionaryEnv) + (T_RecordExpressionBindings_vOut139 _tlIself) = inv_RecordExpressionBindings_s140 _tlX140 (T_RecordExpressionBindings_vIn139 _tlOdictionaryEnv) + _self = rule563 _hdIself _tlIself + _lhsOself :: RecordExpressionBindings + _lhsOself = rule564 _self + _hdOdictionaryEnv = rule565 _lhsIdictionaryEnv + _tlOdictionaryEnv = rule566 _lhsIdictionaryEnv + __result_ = T_RecordExpressionBindings_vOut139 _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule563 #-} + rule563 = \ ((_hdIself) :: RecordExpressionBinding) ((_tlIself) :: RecordExpressionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule564 #-} + rule564 = \ _self -> + _self + {-# INLINE rule565 #-} + rule565 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule566 #-} + rule566 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_RecordExpressionBindings_Nil #-} +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 _lhsIdictionaryEnv) -> ( let + _self = rule567 () + _lhsOself :: RecordExpressionBindings + _lhsOself = rule568 _self + __result_ = T_RecordExpressionBindings_vOut139 _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule567 #-} + rule567 = \ (_ :: ()) -> + [] + {-# INLINE rule568 #-} + rule568 = \ _self -> + _self + +-- RecordPatternBinding ---------------------------------------- +-- wrapper +data Inh_RecordPatternBinding = Inh_RecordPatternBinding { } +data Syn_RecordPatternBinding = Syn_RecordPatternBinding { self_Syn_RecordPatternBinding :: (RecordPatternBinding) } +{-# INLINABLE wrap_RecordPatternBinding #-} +wrap_RecordPatternBinding :: T_RecordPatternBinding -> Inh_RecordPatternBinding -> (Syn_RecordPatternBinding ) +wrap_RecordPatternBinding (T_RecordPatternBinding act) (Inh_RecordPatternBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBinding_vIn142 + (T_RecordPatternBinding_vOut142 _lhsOself) <- return (inv_RecordPatternBinding_s143 sem arg) + return (Syn_RecordPatternBinding _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBinding #-} +sem_RecordPatternBinding :: RecordPatternBinding -> T_RecordPatternBinding +sem_RecordPatternBinding ( RecordPatternBinding_RecordPatternBinding range_ name_ pattern_ ) = sem_RecordPatternBinding_RecordPatternBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) + +-- semantic domain +newtype T_RecordPatternBinding = T_RecordPatternBinding { + attach_T_RecordPatternBinding :: Identity (T_RecordPatternBinding_s143 ) + } +newtype T_RecordPatternBinding_s143 = C_RecordPatternBinding_s143 { + inv_RecordPatternBinding_s143 :: (T_RecordPatternBinding_v142 ) + } +data T_RecordPatternBinding_s144 = C_RecordPatternBinding_s144 +type T_RecordPatternBinding_v142 = (T_RecordPatternBinding_vIn142 ) -> (T_RecordPatternBinding_vOut142 ) +data T_RecordPatternBinding_vIn142 = T_RecordPatternBinding_vIn142 +data T_RecordPatternBinding_vOut142 = T_RecordPatternBinding_vOut142 (RecordPatternBinding) +{-# NOINLINE sem_RecordPatternBinding_RecordPatternBinding #-} +sem_RecordPatternBinding_RecordPatternBinding :: T_Range -> T_Name -> T_Pattern -> T_RecordPatternBinding +sem_RecordPatternBinding_RecordPatternBinding arg_range_ arg_name_ arg_pattern_ = T_RecordPatternBinding (return st143) where + {-# NOINLINE st143 #-} + st143 = let + v142 :: T_RecordPatternBinding_v142 + v142 = \ (T_RecordPatternBinding_vIn142 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIself _patternIvars) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _self = rule569 _nameIself _patternIself _rangeIself + _lhsOself :: RecordPatternBinding + _lhsOself = rule570 _self + __result_ = T_RecordPatternBinding_vOut142 _lhsOself + in __result_ ) + in C_RecordPatternBinding_s143 v142 + {-# INLINE rule569 #-} + rule569 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + RecordPatternBinding_RecordPatternBinding _rangeIself _nameIself _patternIself + {-# INLINE rule570 #-} + rule570 = \ _self -> + _self + +-- RecordPatternBindings --------------------------------------- +-- wrapper +data Inh_RecordPatternBindings = Inh_RecordPatternBindings { } +data Syn_RecordPatternBindings = Syn_RecordPatternBindings { self_Syn_RecordPatternBindings :: (RecordPatternBindings) } +{-# INLINABLE wrap_RecordPatternBindings #-} +wrap_RecordPatternBindings :: T_RecordPatternBindings -> Inh_RecordPatternBindings -> (Syn_RecordPatternBindings ) +wrap_RecordPatternBindings (T_RecordPatternBindings act) (Inh_RecordPatternBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBindings_vIn145 + (T_RecordPatternBindings_vOut145 _lhsOself) <- return (inv_RecordPatternBindings_s146 sem arg) + return (Syn_RecordPatternBindings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBindings #-} +sem_RecordPatternBindings :: RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings list = Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list) + +-- semantic domain +newtype T_RecordPatternBindings = T_RecordPatternBindings { + attach_T_RecordPatternBindings :: Identity (T_RecordPatternBindings_s146 ) + } +newtype T_RecordPatternBindings_s146 = C_RecordPatternBindings_s146 { + inv_RecordPatternBindings_s146 :: (T_RecordPatternBindings_v145 ) + } +data T_RecordPatternBindings_s147 = C_RecordPatternBindings_s147 +type T_RecordPatternBindings_v145 = (T_RecordPatternBindings_vIn145 ) -> (T_RecordPatternBindings_vOut145 ) +data T_RecordPatternBindings_vIn145 = T_RecordPatternBindings_vIn145 +data T_RecordPatternBindings_vOut145 = T_RecordPatternBindings_vOut145 (RecordPatternBindings) +{-# NOINLINE sem_RecordPatternBindings_Cons #-} +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> T_RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings_Cons arg_hd_ arg_tl_ = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 ) -> ( let + _hdX143 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBinding (arg_hd_)) + _tlX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_tl_)) + (T_RecordPatternBinding_vOut142 _hdIself) = inv_RecordPatternBinding_s143 _hdX143 (T_RecordPatternBinding_vIn142 ) + (T_RecordPatternBindings_vOut145 _tlIself) = inv_RecordPatternBindings_s146 _tlX146 (T_RecordPatternBindings_vIn145 ) + _self = rule571 _hdIself _tlIself + _lhsOself :: RecordPatternBindings + _lhsOself = rule572 _self + __result_ = T_RecordPatternBindings_vOut145 _lhsOself + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule571 #-} + rule571 = \ ((_hdIself) :: RecordPatternBinding) ((_tlIself) :: RecordPatternBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule572 #-} + rule572 = \ _self -> + _self +{-# NOINLINE sem_RecordPatternBindings_Nil #-} +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 ) -> ( let + _self = rule573 () + _lhsOself :: RecordPatternBindings + _lhsOself = rule574 _self + __result_ = T_RecordPatternBindings_vOut145 _lhsOself + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule573 #-} + rule573 = \ (_ :: ()) -> + [] + {-# INLINE rule574 #-} + rule574 = \ _self -> + _self + +-- RightHandSide ----------------------------------------------- +-- wrapper +data Inh_RightHandSide = Inh_RightHandSide { dictionaryEnv_Inh_RightHandSide :: (DictionaryEnvironment) } +data Syn_RightHandSide = Syn_RightHandSide { core_Syn_RightHandSide :: ( Core.Expr ), isGuarded_Syn_RightHandSide :: (Bool), self_Syn_RightHandSide :: (RightHandSide) } +{-# INLINABLE wrap_RightHandSide #-} +wrap_RightHandSide :: T_RightHandSide -> Inh_RightHandSide -> (Syn_RightHandSide ) +wrap_RightHandSide (T_RightHandSide act) (Inh_RightHandSide _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RightHandSide_vIn148 _lhsIdictionaryEnv + (T_RightHandSide_vOut148 _lhsOcore _lhsOisGuarded _lhsOself) <- return (inv_RightHandSide_s149 sem arg) + return (Syn_RightHandSide _lhsOcore _lhsOisGuarded _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RightHandSide #-} +sem_RightHandSide :: RightHandSide -> T_RightHandSide +sem_RightHandSide ( RightHandSide_Expression range_ expression_ where_ ) = sem_RightHandSide_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_MaybeDeclarations where_ ) +sem_RightHandSide ( RightHandSide_Guarded range_ guardedexpressions_ where_ ) = sem_RightHandSide_Guarded ( sem_Range range_ ) ( sem_GuardedExpressions guardedexpressions_ ) ( sem_MaybeDeclarations where_ ) + +-- semantic domain +newtype T_RightHandSide = T_RightHandSide { + attach_T_RightHandSide :: Identity (T_RightHandSide_s149 ) + } +newtype T_RightHandSide_s149 = C_RightHandSide_s149 { + inv_RightHandSide_s149 :: (T_RightHandSide_v148 ) + } +data T_RightHandSide_s150 = C_RightHandSide_s150 +type T_RightHandSide_v148 = (T_RightHandSide_vIn148 ) -> (T_RightHandSide_vOut148 ) +data T_RightHandSide_vIn148 = T_RightHandSide_vIn148 (DictionaryEnvironment) +data T_RightHandSide_vOut148 = T_RightHandSide_vOut148 ( Core.Expr ) (Bool) (RightHandSide) +{-# NOINLINE sem_RightHandSide_Expression #-} +sem_RightHandSide_Expression :: T_Range -> T_Expression -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Expression arg_range_ arg_expression_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + (T_MaybeDeclarations_vOut88 _whereIcore _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOdictionaryEnv) + _lhsOcore :: Core.Expr + _lhsOcore = rule575 _expressionIcore _whereIcore + _lhsOisGuarded :: Bool + _lhsOisGuarded = rule576 () + _self = rule577 _expressionIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule578 _self + _expressionOdictionaryEnv = rule579 _lhsIdictionaryEnv + _whereOdictionaryEnv = rule580 _lhsIdictionaryEnv + __result_ = T_RightHandSide_vOut148 _lhsOcore _lhsOisGuarded _lhsOself + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule575 #-} + rule575 = \ ((_expressionIcore) :: Core.Expr ) ((_whereIcore) :: Core.Expr -> Core.Expr ) -> + _whereIcore _expressionIcore + {-# INLINE rule576 #-} + rule576 = \ (_ :: ()) -> + False + {-# INLINE rule577 #-} + rule577 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Expression _rangeIself _expressionIself _whereIself + {-# INLINE rule578 #-} + rule578 = \ _self -> + _self + {-# INLINE rule579 #-} + rule579 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule580 #-} + rule580 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_RightHandSide_Guarded #-} +sem_RightHandSide_Guarded :: T_Range -> T_GuardedExpressions -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Guarded arg_range_ arg_guardedexpressions_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardedexpressionsX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_guardedexpressions_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_GuardedExpressions_vOut64 _guardedexpressionsIcore _guardedexpressionsIself) = inv_GuardedExpressions_s65 _guardedexpressionsX65 (T_GuardedExpressions_vIn64 _guardedexpressionsOdictionaryEnv) + (T_MaybeDeclarations_vOut88 _whereIcore _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOdictionaryEnv) + _lhsOisGuarded :: Bool + _lhsOisGuarded = rule581 () + _lhsOcore :: Core.Expr + _lhsOcore = rule582 _guardedexpressionsIcore _whereIcore + _self = rule583 _guardedexpressionsIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule584 _self + _guardedexpressionsOdictionaryEnv = rule585 _lhsIdictionaryEnv + _whereOdictionaryEnv = rule586 _lhsIdictionaryEnv + __result_ = T_RightHandSide_vOut148 _lhsOcore _lhsOisGuarded _lhsOself + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule581 #-} + rule581 = \ (_ :: ()) -> + True + {-# INLINE rule582 #-} + rule582 = \ ((_guardedexpressionsIcore) :: [Core.Expr -> Core.Expr] ) ((_whereIcore) :: Core.Expr -> Core.Expr ) -> + _whereIcore (foldr ($) (Core.Var nextClauseId) _guardedexpressionsIcore) + {-# INLINE rule583 #-} + rule583 = \ ((_guardedexpressionsIself) :: GuardedExpressions) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Guarded _rangeIself _guardedexpressionsIself _whereIself + {-# INLINE rule584 #-} + rule584 = \ _self -> + _self + {-# INLINE rule585 #-} + rule585 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule586 #-} + rule586 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + +-- SimpleType -------------------------------------------------- +-- wrapper +data Inh_SimpleType = Inh_SimpleType { } +data Syn_SimpleType = Syn_SimpleType { name_Syn_SimpleType :: (Name), self_Syn_SimpleType :: (SimpleType), typevariables_Syn_SimpleType :: (Names) } +{-# INLINABLE wrap_SimpleType #-} +wrap_SimpleType :: T_SimpleType -> Inh_SimpleType -> (Syn_SimpleType ) +wrap_SimpleType (T_SimpleType act) (Inh_SimpleType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_SimpleType_vIn151 + (T_SimpleType_vOut151 _lhsOname _lhsOself _lhsOtypevariables) <- return (inv_SimpleType_s152 sem arg) + return (Syn_SimpleType _lhsOname _lhsOself _lhsOtypevariables) + ) + +-- cata +{-# INLINE sem_SimpleType #-} +sem_SimpleType :: SimpleType -> T_SimpleType +sem_SimpleType ( SimpleType_SimpleType range_ name_ typevariables_ ) = sem_SimpleType_SimpleType ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Names typevariables_ ) + +-- semantic domain +newtype T_SimpleType = T_SimpleType { + attach_T_SimpleType :: Identity (T_SimpleType_s152 ) + } +newtype T_SimpleType_s152 = C_SimpleType_s152 { + inv_SimpleType_s152 :: (T_SimpleType_v151 ) + } +data T_SimpleType_s153 = C_SimpleType_s153 +type T_SimpleType_v151 = (T_SimpleType_vIn151 ) -> (T_SimpleType_vOut151 ) +data T_SimpleType_vIn151 = T_SimpleType_vIn151 +data T_SimpleType_vOut151 = T_SimpleType_vOut151 (Name) (SimpleType) (Names) +{-# NOINLINE sem_SimpleType_SimpleType #-} +sem_SimpleType_SimpleType :: T_Range -> T_Name -> T_Names -> T_SimpleType +sem_SimpleType_SimpleType arg_range_ arg_name_ arg_typevariables_ = T_SimpleType (return st152) where + {-# NOINLINE st152 #-} + st152 = let + v151 :: T_SimpleType_v151 + v151 = \ (T_SimpleType_vIn151 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Names_vOut115 _typevariablesInames _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + _lhsOname :: Name + _lhsOname = rule587 _nameIself + _lhsOtypevariables :: Names + _lhsOtypevariables = rule588 _typevariablesIself + _self = rule589 _nameIself _rangeIself _typevariablesIself + _lhsOself :: SimpleType + _lhsOself = rule590 _self + __result_ = T_SimpleType_vOut151 _lhsOname _lhsOself _lhsOtypevariables + in __result_ ) + in C_SimpleType_s152 v151 + {-# INLINE rule587 #-} + rule587 = \ ((_nameIself) :: Name) -> + _nameIself + {-# INLINE rule588 #-} + rule588 = \ ((_typevariablesIself) :: Names) -> + _typevariablesIself + {-# INLINE rule589 #-} + rule589 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typevariablesIself) :: Names) -> + SimpleType_SimpleType _rangeIself _nameIself _typevariablesIself + {-# INLINE rule590 #-} + rule590 = \ _self -> + _self + +-- Statement --------------------------------------------------- +-- wrapper +data Inh_Statement = Inh_Statement { dictionaryEnv_Inh_Statement :: (DictionaryEnvironment) } +data Syn_Statement = Syn_Statement { core_Syn_Statement :: ( Maybe Core.Expr -> Core.Expr ), self_Syn_Statement :: (Statement) } +{-# INLINABLE wrap_Statement #-} +wrap_Statement :: T_Statement -> Inh_Statement -> (Syn_Statement ) +wrap_Statement (T_Statement act) (Inh_Statement _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statement_vIn154 _lhsIdictionaryEnv + (T_Statement_vOut154 _lhsOcore _lhsOself) <- return (inv_Statement_s155 sem arg) + return (Syn_Statement _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statement #-} +sem_Statement :: Statement -> T_Statement +sem_Statement ( Statement_Expression range_ expression_ ) = sem_Statement_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Let range_ declarations_ ) = sem_Statement_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Statement ( Statement_Generator range_ pattern_ expression_ ) = sem_Statement_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Empty range_ ) = sem_Statement_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Statement = T_Statement { + attach_T_Statement :: Identity (T_Statement_s155 ) + } +newtype T_Statement_s155 = C_Statement_s155 { + inv_Statement_s155 :: (T_Statement_v154 ) + } +data T_Statement_s156 = C_Statement_s156 +type T_Statement_v154 = (T_Statement_vIn154 ) -> (T_Statement_vOut154 ) +data T_Statement_vIn154 = T_Statement_vIn154 (DictionaryEnvironment) +data T_Statement_vOut154 = T_Statement_vOut154 ( Maybe Core.Expr -> Core.Expr ) (Statement) +{-# NOINLINE sem_Statement_Expression #-} +sem_Statement_Expression :: T_Range -> T_Expression -> T_Statement +sem_Statement_Expression arg_range_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _lhsOcore :: Maybe Core.Expr -> Core.Expr + _lhsOcore = rule591 _expressionIcore + _self = rule592 _expressionIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule593 _self + _expressionOdictionaryEnv = rule594 _lhsIdictionaryEnv + __result_ = T_Statement_vOut154 _lhsOcore _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule591 #-} + rule591 = \ ((_expressionIcore) :: Core.Expr ) -> + \theRest -> + case theRest of + Nothing -> _expressionIcore + Just rest -> bind _expressionIcore (Core.Lam dummyId rest) + {-# INLINE rule592 #-} + rule592 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Statement_Expression _rangeIself _expressionIself + {-# INLINE rule593 #-} + rule593 = \ _self -> + _self + {-# INLINE rule594 #-} + rule594 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Statement_Let #-} +sem_Statement_Let :: T_Range -> T_Declarations -> T_Statement +sem_Statement_Let arg_range_ arg_declarations_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIdecls _declarationsIpatBindNr _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOdictionaryEnv _declarationsOimportEnv _declarationsOisTopLevel _declarationsOpatBindNr) + _importEnv = rule595 () + _declarationsOpatBindNr = rule596 () + _declarationsOisTopLevel = rule597 () + _lhsOcore :: Maybe Core.Expr -> Core.Expr + _lhsOcore = rule598 _declarationsIdecls + _self = rule599 _declarationsIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule600 _self + _declarationsOdictionaryEnv = rule601 _lhsIdictionaryEnv + _declarationsOimportEnv = rule602 _importEnv + __result_ = T_Statement_vOut154 _lhsOcore _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule595 #-} + rule595 = \ (_ :: ()) -> + internalError "CodeGeneration.ag" "Statement.Let" "" + {-# INLINE rule596 #-} + rule596 = \ (_ :: ()) -> + 0 + {-# INLINE rule597 #-} + rule597 = \ (_ :: ()) -> + False + {-# INLINE rule598 #-} + rule598 = \ ((_declarationsIdecls) :: [CoreDecl] ) -> + \theRest -> + case theRest of + Nothing -> internalError "ToCoreExpr" "Statement" "'let' can't be last in 'do'" + Just rest -> letrec_ _declarationsIdecls rest + {-# INLINE rule599 #-} + rule599 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Statement_Let _rangeIself _declarationsIself + {-# INLINE rule600 #-} + rule600 = \ _self -> + _self + {-# INLINE rule601 #-} + rule601 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule602 #-} + rule602 = \ _importEnv -> + _importEnv +{-# NOINLINE sem_Statement_Generator #-} +sem_Statement_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Statement +sem_Statement_Generator arg_range_ arg_pattern_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself _patternIvars) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_Expression_vOut40 _expressionIcore _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOdictionaryEnv) + _lhsOcore :: Maybe Core.Expr -> Core.Expr + _lhsOcore = rule603 _expressionIcore _patternIself _rangeIself + _self = rule604 _expressionIself _patternIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule605 _self + _expressionOdictionaryEnv = rule606 _lhsIdictionaryEnv + __result_ = T_Statement_vOut154 _lhsOcore _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule603 #-} + rule603 = \ ((_expressionIcore) :: Core.Expr ) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + \theRest -> case theRest of + Nothing -> internalError "ToCoreExpr" "Statement" "generator can't be last in 'do'" + Just rest -> + let_ nextClauseId (patternMatchFail "generator" _rangeIself) + (let_ + okId + (Core.Lam parameterId + (patternToCore (parameterId, _patternIself) rest) + ) + (_expressionIcore `bind` Core.Var okId) + ) + {-# INLINE rule604 #-} + rule604 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Statement_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule605 #-} + rule605 = \ _self -> + _self + {-# INLINE rule606 #-} + rule606 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Statement_Empty #-} +sem_Statement_Empty :: T_Range -> T_Statement +sem_Statement_Empty arg_range_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIdictionaryEnv) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcore :: Maybe Core.Expr -> Core.Expr + _lhsOcore = rule607 () + _self = rule608 _rangeIself + _lhsOself :: Statement + _lhsOself = rule609 _self + __result_ = T_Statement_vOut154 _lhsOcore _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule607 #-} + rule607 = \ (_ :: ()) -> + \theRest -> + case theRest of + Nothing -> internalError "ToCoreExpr" "Statement" "empty statements not supported" + Just rest -> rest + {-# INLINE rule608 #-} + rule608 = \ ((_rangeIself) :: Range) -> + Statement_Empty _rangeIself + {-# INLINE rule609 #-} + rule609 = \ _self -> + _self + +-- Statements -------------------------------------------------- +-- wrapper +data Inh_Statements = Inh_Statements { dictionaryEnv_Inh_Statements :: (DictionaryEnvironment) } +data Syn_Statements = Syn_Statements { core_Syn_Statements :: ( [Maybe Core.Expr -> Core.Expr] ), self_Syn_Statements :: (Statements) } +{-# INLINABLE wrap_Statements #-} +wrap_Statements :: T_Statements -> Inh_Statements -> (Syn_Statements ) +wrap_Statements (T_Statements act) (Inh_Statements _lhsIdictionaryEnv) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statements_vIn157 _lhsIdictionaryEnv + (T_Statements_vOut157 _lhsOcore _lhsOself) <- return (inv_Statements_s158 sem arg) + return (Syn_Statements _lhsOcore _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statements #-} +sem_Statements :: Statements -> T_Statements +sem_Statements list = Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list) + +-- semantic domain +newtype T_Statements = T_Statements { + attach_T_Statements :: Identity (T_Statements_s158 ) + } +newtype T_Statements_s158 = C_Statements_s158 { + inv_Statements_s158 :: (T_Statements_v157 ) + } +data T_Statements_s159 = C_Statements_s159 +type T_Statements_v157 = (T_Statements_vIn157 ) -> (T_Statements_vOut157 ) +data T_Statements_vIn157 = T_Statements_vIn157 (DictionaryEnvironment) +data T_Statements_vOut157 = T_Statements_vOut157 ( [Maybe Core.Expr -> Core.Expr] ) (Statements) +{-# NOINLINE sem_Statements_Cons #-} +sem_Statements_Cons :: T_Statement -> T_Statements -> T_Statements +sem_Statements_Cons arg_hd_ arg_tl_ = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 _lhsIdictionaryEnv) -> ( let + _hdX155 = Control.Monad.Identity.runIdentity (attach_T_Statement (arg_hd_)) + _tlX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_tl_)) + (T_Statement_vOut154 _hdIcore _hdIself) = inv_Statement_s155 _hdX155 (T_Statement_vIn154 _hdOdictionaryEnv) + (T_Statements_vOut157 _tlIcore _tlIself) = inv_Statements_s158 _tlX158 (T_Statements_vIn157 _tlOdictionaryEnv) + _lhsOcore :: [Maybe Core.Expr -> Core.Expr] + _lhsOcore = rule610 _hdIcore _tlIcore + _self = rule611 _hdIself _tlIself + _lhsOself :: Statements + _lhsOself = rule612 _self + _hdOdictionaryEnv = rule613 _lhsIdictionaryEnv + _tlOdictionaryEnv = rule614 _lhsIdictionaryEnv + __result_ = T_Statements_vOut157 _lhsOcore _lhsOself + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule610 #-} + rule610 = \ ((_hdIcore) :: Maybe Core.Expr -> Core.Expr ) ((_tlIcore) :: [Maybe Core.Expr -> Core.Expr] ) -> + _hdIcore : _tlIcore + {-# INLINE rule611 #-} + rule611 = \ ((_hdIself) :: Statement) ((_tlIself) :: Statements) -> + (:) _hdIself _tlIself + {-# INLINE rule612 #-} + rule612 = \ _self -> + _self + {-# INLINE rule613 #-} + rule613 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv + {-# INLINE rule614 #-} + rule614 = \ ((_lhsIdictionaryEnv) :: DictionaryEnvironment) -> + _lhsIdictionaryEnv +{-# NOINLINE sem_Statements_Nil #-} +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 _lhsIdictionaryEnv) -> ( let + _lhsOcore :: [Maybe Core.Expr -> Core.Expr] + _lhsOcore = rule615 () + _self = rule616 () + _lhsOself :: Statements + _lhsOself = rule617 _self + __result_ = T_Statements_vOut157 _lhsOcore _lhsOself + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule615 #-} + rule615 = \ (_ :: ()) -> + [] + {-# INLINE rule616 #-} + rule616 = \ (_ :: ()) -> + [] + {-# INLINE rule617 #-} + rule617 = \ _self -> + _self + +-- Strings ----------------------------------------------------- +-- wrapper +data Inh_Strings = Inh_Strings { } +data Syn_Strings = Syn_Strings { self_Syn_Strings :: (Strings) } +{-# INLINABLE wrap_Strings #-} +wrap_Strings :: T_Strings -> Inh_Strings -> (Syn_Strings ) +wrap_Strings (T_Strings act) (Inh_Strings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Strings_vIn160 + (T_Strings_vOut160 _lhsOself) <- return (inv_Strings_s161 sem arg) + return (Syn_Strings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Strings #-} +sem_Strings :: Strings -> T_Strings +sem_Strings list = Prelude.foldr sem_Strings_Cons sem_Strings_Nil list + +-- semantic domain +newtype T_Strings = T_Strings { + attach_T_Strings :: Identity (T_Strings_s161 ) + } +newtype T_Strings_s161 = C_Strings_s161 { + inv_Strings_s161 :: (T_Strings_v160 ) + } +data T_Strings_s162 = C_Strings_s162 +type T_Strings_v160 = (T_Strings_vIn160 ) -> (T_Strings_vOut160 ) +data T_Strings_vIn160 = T_Strings_vIn160 +data T_Strings_vOut160 = T_Strings_vOut160 (Strings) +{-# NOINLINE sem_Strings_Cons #-} +sem_Strings_Cons :: (String) -> T_Strings -> T_Strings +sem_Strings_Cons arg_hd_ arg_tl_ = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _tlX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_tl_)) + (T_Strings_vOut160 _tlIself) = inv_Strings_s161 _tlX161 (T_Strings_vIn160 ) + _self = rule618 _tlIself arg_hd_ + _lhsOself :: Strings + _lhsOself = rule619 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule618 #-} + rule618 = \ ((_tlIself) :: Strings) hd_ -> + (:) hd_ _tlIself + {-# INLINE rule619 #-} + rule619 = \ _self -> + _self +{-# NOINLINE sem_Strings_Nil #-} +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _self = rule620 () + _lhsOself :: Strings + _lhsOself = rule621 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule620 #-} + rule620 = \ (_ :: ()) -> + [] + {-# INLINE rule621 #-} + rule621 = \ _self -> + _self + +-- Type -------------------------------------------------------- +-- wrapper +data Inh_Type = Inh_Type { } +data Syn_Type = Syn_Type { self_Syn_Type :: (Type) } +{-# INLINABLE wrap_Type #-} +wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) +wrap_Type (T_Type act) (Inh_Type ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Type_vIn163 + (T_Type_vOut163 _lhsOself) <- return (inv_Type_s164 sem arg) + return (Syn_Type _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Type #-} +sem_Type :: Type -> T_Type +sem_Type ( Type_Application range_ prefix_ function_ arguments_ ) = sem_Type_Application ( sem_Range range_ ) prefix_ ( sem_Type function_ ) ( sem_Types arguments_ ) +sem_Type ( Type_Variable range_ name_ ) = sem_Type_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Constructor range_ name_ ) = sem_Type_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Qualified range_ context_ type_ ) = sem_Type_Qualified ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Type type_ ) +sem_Type ( Type_Forall range_ typevariables_ type_ ) = sem_Type_Forall ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Exists range_ typevariables_ type_ ) = sem_Type_Exists ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Parenthesized range_ type_ ) = sem_Type_Parenthesized ( sem_Range range_ ) ( sem_Type type_ ) + +-- semantic domain +newtype T_Type = T_Type { + attach_T_Type :: Identity (T_Type_s164 ) + } +newtype T_Type_s164 = C_Type_s164 { + inv_Type_s164 :: (T_Type_v163 ) + } +data T_Type_s165 = C_Type_s165 +type T_Type_v163 = (T_Type_vIn163 ) -> (T_Type_vOut163 ) +data T_Type_vIn163 = T_Type_vIn163 +data T_Type_vOut163 = T_Type_vOut163 (Type) +{-# NOINLINE sem_Type_Application #-} +sem_Type_Application :: T_Range -> (Bool) -> T_Type -> T_Types -> T_Type +sem_Type_Application arg_range_ arg_prefix_ arg_function_ arg_arguments_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_function_)) + _argumentsX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _functionIself) = inv_Type_s164 _functionX164 (T_Type_vIn163 ) + (T_Types_vOut166 _argumentsIself) = inv_Types_s167 _argumentsX167 (T_Types_vIn166 ) + _self = rule622 _argumentsIself _functionIself _rangeIself arg_prefix_ + _lhsOself :: Type + _lhsOself = rule623 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule622 #-} + rule622 = \ ((_argumentsIself) :: Types) ((_functionIself) :: Type) ((_rangeIself) :: Range) prefix_ -> + Type_Application _rangeIself prefix_ _functionIself _argumentsIself + {-# INLINE rule623 #-} + rule623 = \ _self -> + _self +{-# NOINLINE sem_Type_Variable #-} +sem_Type_Variable :: T_Range -> T_Name -> T_Type +sem_Type_Variable arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule624 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule625 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule624 #-} + rule624 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Variable _rangeIself _nameIself + {-# INLINE rule625 #-} + rule625 = \ _self -> + _self +{-# NOINLINE sem_Type_Constructor #-} +sem_Type_Constructor :: T_Range -> T_Name -> T_Type +sem_Type_Constructor arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule626 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule627 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule626 #-} + rule626 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Constructor _rangeIself _nameIself + {-# INLINE rule627 #-} + rule627 = \ _self -> + _self +{-# NOINLINE sem_Type_Qualified #-} +sem_Type_Qualified :: T_Range -> T_ContextItems -> T_Type -> T_Type +sem_Type_Qualified arg_range_ arg_context_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule628 _contextIself _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule629 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule628 #-} + rule628 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Qualified _rangeIself _contextIself _typeIself + {-# INLINE rule629 #-} + rule629 = \ _self -> + _self +{-# NOINLINE sem_Type_Forall #-} +sem_Type_Forall :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Forall arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesInames _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule630 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule631 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule630 #-} + rule630 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Forall _rangeIself _typevariablesIself _typeIself + {-# INLINE rule631 #-} + rule631 = \ _self -> + _self +{-# NOINLINE sem_Type_Exists #-} +sem_Type_Exists :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Exists arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesInames _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule632 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule633 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule632 #-} + rule632 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Exists _rangeIself _typevariablesIself _typeIself + {-# INLINE rule633 #-} + rule633 = \ _self -> + _self +{-# NOINLINE sem_Type_Parenthesized #-} +sem_Type_Parenthesized :: T_Range -> T_Type -> T_Type +sem_Type_Parenthesized arg_range_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule634 _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule635 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule634 #-} + rule634 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Parenthesized _rangeIself _typeIself + {-# INLINE rule635 #-} + rule635 = \ _self -> + _self + +-- Types ------------------------------------------------------- +-- wrapper +data Inh_Types = Inh_Types { } +data Syn_Types = Syn_Types { self_Syn_Types :: (Types) } +{-# INLINABLE wrap_Types #-} +wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) +wrap_Types (T_Types act) (Inh_Types ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Types_vIn166 + (T_Types_vOut166 _lhsOself) <- return (inv_Types_s167 sem arg) + return (Syn_Types _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Types #-} +sem_Types :: Types -> T_Types +sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) + +-- semantic domain +newtype T_Types = T_Types { + attach_T_Types :: Identity (T_Types_s167 ) + } +newtype T_Types_s167 = C_Types_s167 { + inv_Types_s167 :: (T_Types_v166 ) + } +data T_Types_s168 = C_Types_s168 +type T_Types_v166 = (T_Types_vIn166 ) -> (T_Types_vOut166 ) +data T_Types_vIn166 = T_Types_vIn166 +data T_Types_vOut166 = T_Types_vOut166 (Types) +{-# NOINLINE sem_Types_Cons #-} +sem_Types_Cons :: T_Type -> T_Types -> T_Types +sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _hdX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) + _tlX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) + (T_Type_vOut163 _hdIself) = inv_Type_s164 _hdX164 (T_Type_vIn163 ) + (T_Types_vOut166 _tlIself) = inv_Types_s167 _tlX167 (T_Types_vIn166 ) + _self = rule636 _hdIself _tlIself + _lhsOself :: Types + _lhsOself = rule637 _self + __result_ = T_Types_vOut166 _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule636 #-} + rule636 = \ ((_hdIself) :: Type) ((_tlIself) :: Types) -> + (:) _hdIself _tlIself + {-# INLINE rule637 #-} + rule637 = \ _self -> + _self +{-# NOINLINE sem_Types_Nil #-} +sem_Types_Nil :: T_Types +sem_Types_Nil = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _self = rule638 () + _lhsOself :: Types + _lhsOself = rule639 _self + __result_ = T_Types_vOut166 _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule638 #-} + rule638 = \ (_ :: ()) -> + [] + {-# INLINE rule639 #-} + rule639 = \ _self -> + _self diff --git a/src/Helium/CodeGeneration/CoreToLvm.hs b/src/Helium/CodeGeneration/CoreToLvm.hs new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/CoreToLvm.hs @@ -0,0 +1,29 @@ +{-| Module : CoreToLvm + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.CodeGeneration.CoreToLvm ( coreToLvm ) where + +import Lvm.Core.Expr (CoreModule) +import Lvm.Common.Id (newNameSupply) +import Lvm.Core.ToAsm (coreToAsm) -- enriched lambda expressions (Core) to Asm +import Lvm.Asm.ToLvm (asmToLvm) -- translate Asm to instructions +import Lvm.Asm.Inline (asmInline) -- optimize Asm (ie. inlining) +import Lvm.Write (lvmWriteFile) + +coreToLvm :: [Char] -> CoreModule -> IO () +coreToLvm source coremod = do + nameSupply <- newNameSupply + + -- coreRemoveDead gebeurt al in Compile.hs + let asmmod = coreToAsm nameSupply coremod + asmopt = asmInline asmmod + lvmmod = asmToLvm asmopt + target = source ++ ".lvm" + + -- putDoc (lvmPretty lvmmod) + lvmWriteFile target lvmmod diff --git a/src/Helium/CodeGeneration/CoreUtils.hs b/src/Helium/CodeGeneration/CoreUtils.hs new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/CoreUtils.hs @@ -0,0 +1,119 @@ +{-| Module : CoreUtils + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.CodeGeneration.CoreUtils + ( custom, customStrategy + , stringToCore, coreList + , let_, if_, app_, letrec_ + , cons, nil + , var, decl + , float, packedString + ) where + +import Lvm.Core.Expr +import Lvm.Common.Id +import Lvm.Core.Utils +import Data.Char +import Lvm.Common.Byte(bytesFromString) +import qualified Lvm.Core.Expr as Core + +infixl `app_` + +custom :: String -> String -> Custom +custom sort text = + CustomDecl + (DeclKindCustom (idFromString sort)) + [CustomBytes (bytesFromString text)] + + +customStrategy :: String -> Decl a +customStrategy text = + DeclCustom + { declName = idFromString "" + , declAccess = Defined { accessPublic = True } + , declKind = DeclKindCustom (idFromString "strategy") + , declCustoms = [custom "strategy" text] + } + +app_ :: Expr -> Expr -> Expr +app_ f x = Ap f x + +let_ :: Id -> Expr -> Expr -> Expr +let_ x e b = Let (NonRec (Bind x e)) b + +letrec_ :: [CoreDecl] -> Expr -> Expr +letrec_ bs e = + Let + (Rec + [ Bind ident expr + | DeclValue { declName = ident, valueValue = expr } <- bs + ] + ) + e + +-- Function "if_" builds a Core expression of the following form +-- let! guardId = in +-- match guardId +-- True -> +-- _ -> +if_ :: Expr -> Expr -> Expr -> Expr +if_ guardExpr thenExpr elseExpr = + Let + (Strict (Bind guardId guardExpr)) + (Match guardId + [ Alt (PatCon (ConId trueId) []) thenExpr + , Alt PatDefault elseExpr + ] + ) + +-- Function "coreList" builds a linked list of the given expressions +-- Example: coreList [e1, e2] ==> +-- Ap (Ap (Con ":") e1) +-- (Ap (Ap (Con ":") e2) +-- (Con "[]") +-- ) +coreList :: [Expr] -> Expr +coreList = foldr cons nil + +cons :: Expr -> Expr -> Expr +cons x xs = Con (ConId consId) `app_` x `app_` xs + +nil :: Expr +nil = Con (ConId nilId) + +nilId, consId, trueId, guardId :: Id +( nilId : consId : trueId : guardId : []) = + map idFromString ["[]", ":", "True", "guard$"] + +-- Function "stringToCore" converts a string to a Core expression +stringToCore :: String -> Expr +stringToCore [x] = cons (Lit (LitInt (ord x))) nil +stringToCore xs = var "$primPackedToString" `app_` packedString xs + +var :: String -> Expr +var x = Var (idFromString x) + +--Core.Lit (Core.LitDouble (read @value)) PUSHFLOAT nog niet geimplementeerd +float :: String -> Expr +float f = + Core.Ap + (Core.Var (idFromString "$primStringToFloat")) + ( Core.Lit (Core.LitBytes (bytesFromString f)) ) + +decl :: Bool -> String -> Expr -> CoreDecl +decl isPublic x e = + DeclValue + { declName = idFromString x + , declAccess = Defined { accessPublic = isPublic } + , valueEnc = Nothing + , valueValue = e + , declCustoms = [] + } + +packedString :: String -> Expr +packedString s = Lit (LitBytes (bytesFromString s)) diff --git a/src/Helium/CodeGeneration/DerivingEq.hs b/src/Helium/CodeGeneration/DerivingEq.hs new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/DerivingEq.hs @@ -0,0 +1,96 @@ +{-| Module : DerivingEq + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.CodeGeneration.DerivingEq(dataDictionary) where + +import qualified Helium.Syntax.UHA_Syntax as UHA +import Helium.Syntax.UHA_Utils +import Helium.CodeGeneration.CoreUtils +import Lvm.Core.Expr +import Lvm.Core.Utils +import Lvm.Common.Id +import Helium.Utils.Utils + +-- Eq Dictionary for a data type declaration +dataDictionary :: UHA.Declaration -> CoreDecl +dataDictionary (UHA.Declaration_Data _ _ (UHA.SimpleType_SimpleType _ name names) constructors _) = + DeclValue + { declName = idFromString ("$dictEq" ++ getNameName name) + , declAccess = public + , valueEnc = Nothing + , valueValue = eqFunction names constructors + , declCustoms = [ custom "type" ("DictEq" ++ getNameName name) ] + } + where +dataDictionary _ = error "pattern match failure in CodeGeneration.Deriving.dataDictionary" + +-- Example: data X a b = C a b Int | D Char b +eqFunction :: [UHA.Name] -> [UHA.Constructor] -> Expr +eqFunction names constructors = + let + body = + Let (Strict (Bind fstArg (Var fstArg))) -- evaluate both + (Let (Strict (Bind sndArg (Var sndArg))) + (Match fstArg -- case $fstArg of ... + (map makeAlt constructors))) + in + foldr Lam body (map idFromName names ++ [fstArg, sndArg]) -- \a b $fstArg $sndArg -> + +fstArg, sndArg :: Id +[fstArg, sndArg] = map idFromString ["$fstArg", "$sndArg"] + +makeAlt :: UHA.Constructor -> Alt +makeAlt constructor = + -- C $v0 $v1 $v2 -> ... + Alt (PatCon (ConId ident) vs) + -- case $sndArg of + -- C $w0 $w1 $w2 -> ... + -- ?? $v0 $w0 && + -- ?? $v1 $w1 && + -- ?? $v2 $w2 + -- _ -> False + (Match sndArg + [ Alt (PatCon (ConId ident) ws) + ( if null types then Con (ConId (idFromString "True")) + else + foldr1 andCore [ Ap (Ap (eqFunForType tp) (Var v)) (Var w) + | (v, w, tp) <- zip3 vs ws types + ] + ) + , Alt PatDefault (Con (ConId (idFromString "False"))) + ]) + where + (ident, types) = nameAndTypes constructor + vs = [ idFromString ("$v"++show i) | i <- [0..length types-1] ] + ws = [ idFromString ("$w"++show i) | i <- [0..length types-1] ] +{- constructorToPat :: Id -> [UHA.Type] -> Pat + constructorToPat id ts = + PatCon (ConId ident) [ idFromNumber i | i <- [1..length ts] ] -} + andCore x y = Ap (Ap (Var (idFromString "&&")) x) y + +nameAndTypes :: UHA.Constructor -> (Id, [UHA.Type]) +nameAndTypes c = + case c of + UHA.Constructor_Constructor _ n ts -> (idFromName n, map annotatedTypeToType ts ) + UHA.Constructor_Infix _ t1 n t2 -> (idFromName n, map annotatedTypeToType [t1, t2]) + UHA.Constructor_Record _ _ _ -> error "pattern match failure in CodeGeneration.DerivingEq.nameAndTypes" + where + annotatedTypeToType :: UHA.AnnotatedType -> UHA.Type + annotatedTypeToType (UHA.AnnotatedType_AnnotatedType _ _ t) = t + +--idFromNumber :: Int -> Id +--idFromNumber i = idFromString ("v$" ++ show i) + +eqFunForType :: UHA.Type -> Expr +eqFunForType t = + case t of + UHA.Type_Variable _ n -> Var (idFromName n) + UHA.Type_Constructor _ n -> var ("$dictEq" ++ show n) + UHA.Type_Application _ _ f xs -> foldl Ap (eqFunForType f) (map eqFunForType xs) + UHA.Type_Parenthesized _ ty -> eqFunForType ty + _ -> internalError "DerivingEq" "eqFunForType" "unsupported type" diff --git a/src/Helium/CodeGeneration/DerivingShow.hs b/src/Helium/CodeGeneration/DerivingShow.hs new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/DerivingShow.hs @@ -0,0 +1,182 @@ +{-| Module : DerivingShow + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.CodeGeneration.DerivingShow + ( dataShowFunction + , typeShowFunction + , dataDictionary + , nameOfShowFunction, typeOfShowFunction, showFunctionOfType + ) where + +import qualified Helium.Syntax.UHA_Syntax as UHA +import Helium.Syntax.UHA_Utils +import Helium.CodeGeneration.CoreUtils +import Lvm.Core.Expr +import Lvm.Core.Utils +import Lvm.Common.Id +import Helium.Utils.Utils +import Top.Types + +-- Show function for a data type declaration +dataShowFunction :: UHA.Declaration -> CoreDecl +dataShowFunction (UHA.Declaration_Data _ _ (UHA.SimpleType_SimpleType _ name names) constructors _) = + let typeString = show (typeOfShowFunction name names) + nameId = idFromString ("show" ++ getNameName name) + valueId = idFromString "value$" + in + DeclValue + { declName = nameId + , declAccess = public + , valueEnc = Nothing + , valueValue = foldr Lam + (Let + (Strict (Bind valueId (Var valueId))) + (Match valueId + (map makeAlt constructors) + ) + ) + (map idFromName names ++ [valueId]) + , declCustoms = [ custom "type" typeString ] + } +dataShowFunction _ = error "not supported" + +-- Show Dictionary for a data type declaration +dataDictionary :: UHA.Declaration -> CoreDecl +dataDictionary (UHA.Declaration_Data _ _ (UHA.SimpleType_SimpleType _ name names) _ _) = + let nameId = idFromString ("show" ++ getNameName name) in + DeclValue + { declName = idFromString ("$dictShow" ++ getNameName name) + , declAccess = public + , valueEnc = Nothing + , valueValue = makeShowDictionary (length names) nameId + , declCustoms = [ custom "type" ("DictShow" ++ getNameName name) ] + } + where + makeShowDictionary :: Int -> Id -> Expr + makeShowDictionary nrOfArgs nameId = + let ids = take nrOfArgs [ idFromString ("d" ++ show i) | i <- [(1::Integer)..] ] + idX = idFromString "x" + con = Con (ConTag (Lit (LitInt 0)) 2) + list = [ Ap (Var (idFromString "$show")) (Var ident) | ident <- ids ] + declaration = Bind idX (foldl Ap (Var nameId) list) + body = Let (Strict declaration) (Ap (Ap con (Var idX)) (Ap (Var (idFromString "$showList")) (Var idX))) + in foldr Lam body ids +dataDictionary _ = error "not supported" + +-- Show function for a type synonym +-- type T a b = (b, a) +-- ===> +-- showT :: (a -> String) -> (b -> String) -> T a b -> String +-- showT a b = showTuple2 b a +typeShowFunction :: UHA.Declaration -> Decl Expr +typeShowFunction (UHA.Declaration_Type _ (UHA.SimpleType_SimpleType _ name names) type_) = + let typeString = show (typeOfShowFunction name names) in + DeclValue + { declName = idFromString ("show" ++ getNameName name) + , declAccess = public + , valueEnc = Nothing + , valueValue = foldr (Lam . idFromName) (showFunctionOfType False type_) names + , declCustoms = [ custom "type" typeString ] + } +typeShowFunction _ = error "not supported" + +-- Convert a data type constructor to a Core alternative +makeAlt :: UHA.Constructor -> Alt +makeAlt c = Alt (constructorToPat ident types) (showConstructor ident types) + where + (ident, types) = nameAndTypes c + + nameAndTypes :: UHA.Constructor -> (Id, [UHA.Type]) + nameAndTypes c' = + case c' of + UHA.Constructor_Constructor _ n ts -> (idFromName n, map annotatedTypeToType ts ) + UHA.Constructor_Infix _ t1 n t2 -> (idFromName n, map annotatedTypeToType [t1, t2]) + UHA.Constructor_Record _ _ _ -> error "not supported" + constructorToPat :: Id -> [UHA.Type] -> Pat + constructorToPat ident' ts = + PatCon (ConId ident') [ idFromNumber i | i <- [1..length ts] ] + + annotatedTypeToType :: UHA.AnnotatedType -> UHA.Type + annotatedTypeToType (UHA.AnnotatedType_AnnotatedType _ _ t) = t + +-- Show expression for one constructor +showConstructor :: Id -> [UHA.Type] -> Expr +showConstructor c ts -- name of constructor and paramater types + | isConOp && length ts == 2 = + Ap (Var (idFromString "$primConcat")) $ coreList + [ stringToCore "(" + , Ap (showFunctionOfType False (ts!!0)) (Var (idFromNumber 1)) + , stringToCore name + , Ap (showFunctionOfType False (ts!!1)) (Var (idFromNumber 2)) + , stringToCore ")" + ] + | otherwise = + Ap (Var (idFromString "$primConcat")) $ coreList + ( (if null ts then [] else [stringToCore "("]) + ++ (if isConOp then parens else id) [stringToCore name] + ++ concat + [ [stringToCore " ", Ap (showFunctionOfType False t) (Var (idFromNumber i))] + | (t, i) <- zip ts [1..] + ] + ++ (if null ts then [] else [stringToCore ")"]) + ) + where + name = stringFromId c + isConOp = head name == ':' + parens s = [ stringToCore "(" ] ++ s ++ [ stringToCore ")" ] + +-- What show function to call for a specific type. Returns a Core expression +-- If this function is called for the main function, type variables are printed +-- using showPolymorphic. Otherwise, a show function for the type variable +-- should be available +showFunctionOfType :: Bool -> UHA.Type -> Expr +showFunctionOfType isMainType = sFOT + where + sFOT t = + case t of + UHA.Type_Variable _ n -> if isMainType then var "showPolymorphic" else Var (idFromName n) + -- show Strings not as List of Char but using showString + UHA.Type_Application _ _ + ( UHA.Type_Constructor _ (UHA.Name_Special _ _ "[]") ) -- !!!Name + [ UHA.Type_Constructor _ (UHA.Name_Identifier _ _ "Char") ] -> -- !!!Name + var "showString" + UHA.Type_Constructor _ n -> var ("show" ++ checkForPrimitive (getNameName n)) + UHA.Type_Application _ _ f xs -> foldl Ap (sFOT f) (map sFOT xs) + UHA.Type_Parenthesized _ t' -> showFunctionOfType isMainType t' + _ -> internalError "DerivingShow" "showFunctionOfType" "unsupported type" + +-- Some primitive types have funny names and their Show function has a different name +checkForPrimitive :: String -> String +checkForPrimitive name = + case name of + "[]" -> "List" + "()" -> "Unit" + "->" -> "Function" + ('(':commasAndClose) -> + let arity = length commasAndClose in + if arity > 10 then + internalError "DerivingShow" "checkForPrimitive" "No show functions for tuples with more than 10 elements" + else + "Tuple" ++ show arity + _ -> name + +idFromNumber :: Int -> Id +idFromNumber i = idFromString ("v$" ++ show i) + +nameOfShowFunction :: UHA.Name -> UHA.Name +nameOfShowFunction (UHA.Name_Identifier r m n) = UHA.Name_Identifier r m ("show" ++ n) -- !!!Name +nameOfShowFunction _ = internalError "DerivingShow" "nameOfShowFunction" "name of type must be an identifier" + +typeOfShowFunction :: UHA.Name -> UHA.Names -> TpScheme +typeOfShowFunction name names = + -- Build type from type name and parameters. + -- e.g. data T a b = ... ===> (0 -> String) -> (1 -> String) -> (T 0 1 -> String) + let vars = map TVar (take (length names) [0..]) + types = vars ++ [foldl TApp (TCon (getNameName name)) vars] + in generalizeAll ([] .=>. foldr1 (.->.) (map (.->. stringType) types)) + diff --git a/src/Helium/CodeGeneration/PatternMatch.hs b/src/Helium/CodeGeneration/PatternMatch.hs new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/PatternMatch.hs @@ -0,0 +1,218 @@ +{-| Module : PatternMatch + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.CodeGeneration.PatternMatch(patternToCore, patternsToCore, nextClauseId, freshIds) where + +import qualified Lvm.Core.Expr as Core +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils +import Helium.Syntax.UHA_Range +import Lvm.Common.Id +import Data.Char +import Helium.Utils.Utils +import Helium.CodeGeneration.CoreUtils + +patternsToCore :: [(Id, Pattern)] -> Core.Expr -> Core.Expr +patternsToCore nps continue = fst (patternsToCore' nps continue 0) + +patternsToCore' :: [(Id, Pattern)] -> Core.Expr -> Int -> (Core.Expr, Int) +patternsToCore' [] continue nr = (continue, nr) +patternsToCore' (np:nps) continue nr = + let (expr, nr') = patternsToCore' nps continue nr + in patternToCore' np expr nr' + +patternToCore :: (Id, Pattern) -> Core.Expr -> Core.Expr +patternToCore np continue = fst (patternToCore' np continue 0) + + +withNr :: a -> b -> (b, a) +withNr nr e = (e, nr) + +patternToCore' :: (Id, Pattern) -> Core.Expr -> Int -> (Core.Expr, Int) +patternToCore' (name, pat) continue nr = + case pat of + -- let x = _u1 in ... + Pattern_Variable _ n -> withNr nr $ + if name == wildcardId || name == idFromName n then + continue + else + let_ (idFromName n) (Core.Var name) continue + + -- case _u1 of C _l1 _l2 -> ... + -- _ -> _next + Pattern_Constructor _ n ps -> + let + (ids, nr') = + if all isSimple ps then + (map getIdOfSimplePattern ps, nr) + else + freshIds' "l$" nr (length ps) + (expr, nr'') = + patternsToCore' (zip ids ps) continue nr' + in withNr nr'' $ + case_ name + [ Core.Alt + (Core.PatCon (Core.ConId (idFromName n)) ids) + expr + ] + + -- case _u1 of _l1 : _l2 -> ... + -- _ -> _next + Pattern_InfixConstructor _ p1 n p2 -> + let ie = internalError "PatternMatch" "patternToCore'" "shouldn't look at range" + in patternToCore' (name, Pattern_Constructor ie n [p1, p2]) continue nr + + Pattern_Parenthesized _ p -> + patternToCore' (name, p) continue nr + + -- let n = _u1 in ... + Pattern_As _ n p -> + let (expr, nr') = patternToCore' (name, p) continue nr + in withNr nr' $ + let_ + (idFromName n) (Core.Var name) + expr + + Pattern_Wildcard _ -> withNr nr continue + + -- case _u1 of 42 -> ... + -- _ -> _next + + Pattern_Literal _ l -> + case l of + Literal_Int _ i -> withNr nr $ + case_ name [ Core.Alt (Core.PatLit (Core.LitInt (read i))) continue ] + Literal_Char _ c -> withNr nr $ + case_ name + [ Core.Alt + (Core.PatLit + (Core.LitInt (ord (read ("'" ++ c ++ "'")))) + ) + continue + ] + Literal_Float _ f -> withNr nr $ + if_ (var "$primEqFloat" `app_` float f `app_` Core.Var name) + continue + (Core.Var nextClauseId) +-- !!! if we would have MATCHFLOAT instruction it could be: +-- case_ name [ Core.Alt (Core.PatLit (Core.LitDouble (read f))) continue ] + Literal_String _ s -> + patternToCore' + ( name + , Pattern_List noRange + (map (Pattern_Literal noRange . Literal_Int noRange . show . ord) characters) + ) + continue + nr + where + characters = read ("\"" ++ s ++ "\"") :: String + + Pattern_List _ ps -> + patternToCore' (name, expandPatList ps) continue nr + + Pattern_Tuple _ ps -> + let + (ids, nr') = + if all isSimple ps then + (map getIdOfSimplePattern ps, nr) + else + freshIds' "l$" nr (length ps) + (expr, nr'') = + patternsToCore' (zip ids ps) continue nr' + in withNr nr'' $ + case_ name + [ Core.Alt + (Core.PatCon (Core.ConTag 0 (length ps)) ids) + expr + ] + + + Pattern_Negate _ (Literal_Int r v) -> + patternToCore' + (name, Pattern_Literal r (Literal_Int r neg)) + continue + nr + where + neg = show (-(read v :: Int)) + + Pattern_Negate _ (Literal_Float r v) -> + patternToCore' + (name, Pattern_Literal r (Literal_Float r neg)) + continue + nr + where + neg = show (-(read v :: Float)) + + Pattern_NegateFloat _ (Literal_Float r v) -> + patternToCore' + (name, Pattern_Literal r (Literal_Float r neg)) + continue + nr + where + neg = show (-(read v :: Float)) + + -- ~p ====> + -- let x = case _u1 of p -> x + -- y = case _u1 of p -> y (for each var in p) + -- in continue + Pattern_Irrefutable _ p -> + let vars = map idFromName (patternVars p) + in withNr nr $ foldr + (\v r -> let_ v (patternToCore (name, p) (Core.Var v)) r) + continue + vars + + _ -> internalError "PatternMatch" "patternToCore'" "unknown pattern kind" + +-- [1, 2, 3] ==> 1 : (2 : (3 : [] ) ) +expandPatList :: [Pattern] -> Pattern +expandPatList [] = + Pattern_Constructor noRange (Name_Special noRange [] "[]") [] -- !!!Name +expandPatList (p:ps) = + Pattern_InfixConstructor + noRange + p + (Name_Identifier noRange [] ":") -- !!!Name + (expandPatList ps) + +isSimple :: Pattern -> Bool +isSimple p = + case p of + Pattern_Variable _ _ -> True + Pattern_Wildcard _ -> True + _ -> False + +getIdOfSimplePattern :: Pattern -> Id +getIdOfSimplePattern p = + case p of + Pattern_Variable _ n -> idFromName n + Pattern_Wildcard _ -> wildcardId + _ -> internalError "PatternMatch" "getIdOfSimplePattern" "not a simple pattern" + +freshIds :: String -> Int -> [Id] +freshIds prefix number = fst (freshIds' prefix 0 number) + +freshIds' :: String -> Int -> Int -> ([Id], Int) +freshIds' prefix start number = + ( take number [ idFromString (prefix ++ show i) | i <- [start..] ] + , number + start + ) + +nextClauseAlternative :: Core.Alt +nextClauseAlternative = + Core.Alt Core.PatDefault (Core.Var nextClauseId) + +wildcardId, nextClauseId :: Id +( wildcardId : nextClauseId : [] ) = map idFromString ["_", "nextClause$"] + +case_ :: Id -> [Core.Alt] -> Core.Expr +case_ ident alts = + Core.Let + (Core.Strict (Core.Bind ident (Core.Var ident))) -- let! id = id in + (Core.Match ident (alts++[nextClauseAlternative])) -- match id { alt; ...; alt; _ -> _nextClause } + diff --git a/src/Helium/CodeGeneration/ToCoreDecl.ag b/src/Helium/CodeGeneration/ToCoreDecl.ag new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/ToCoreDecl.ag @@ -0,0 +1,407 @@ +-- ------------------------------------------------------------------------ +-- -- Declarations -- +-- ------------------------------------------------------------------------ + +ATTR Declaration Declarations [ | patBindNr : Int | ] + +SEM MaybeDeclarations [ | | core : { Core.Expr -> Core.Expr } ] + | Nothing lhs.core = \continue -> continue + | Just declarations.patBindNr = 0 + declarations.isTopLevel = False + lhs.core = \continue -> letrec_ @declarations.decls continue + +SEM Declaration + | Type lhs.decls = + let -- if we would have the collected type synonym information here, things could have been + -- done much easier. + (t1,[t2]) = convertFromSimpleTypeAndTypes @simpletype.self [@type.self] + allTypeVars = ftv [t1,t2] + (ts1,ts2) = ( Quantification (allTypeVars, [], [] .=>. t1) :: TpScheme + , Quantification (allTypeVars, [], [] .=>. t2) :: TpScheme + ) + in + [ Core.DeclCustom + { Core.declName = idFromString (getNameName @simpletype.name) + , Core.declAccess = Core.private + , Core.declKind = Core.DeclKindCustom (idFromString "typedecl") + , Core.declCustoms = + [ Core.CustomBytes + (Byte.bytesFromString + ( show ts1 + ++ " = " + ++ show ts2 + ) + ) + , Core.CustomInt + (length @simpletype.typevariables) + ] + } + ] + ++ + [ DerivingShow.typeShowFunction @self ] + + | Data constructors.tag = 0 + constructors.dataTypeName = @simpletype.name + lhs.decls = + map snd @constructors.cons + ++ + [ Core.DeclCustom + { Core.declName = idFromString (getNameName @simpletype.name) + , Core.declAccess = Core.private + , Core.declKind = Core.DeclKindCustom (idFromString "data") + , Core.declCustoms = [Core.CustomInt (length @simpletype.typevariables)] + } + ] + ++ + [ DerivingShow.dataShowFunction @self ] + ++ + (if "Show" `elem` map show @derivings.self + then [ DerivingShow.dataDictionary @self ] + else [] + ) + ++ + (if "Eq" `elem` map show @derivings.self + then [ DerivingEq.dataDictionary @self ] + else [] + ) + + -- range : Range + -- context : ContextItems + -- simpletype : SimpleType + -- constructors : Constructors + -- derivings : Names + + | FunctionBindings loc.ids = freshIds "u$" @bindings.arity + bindings.ids = @loc.ids + bindings.range = @range.self + loc.dictionaries = map predicateToId + (getPredicateForDecl @bindings.name @lhs.dictionaryEnv) + lhs.decls = + [ Core.DeclValue + { Core.declName = idFromName @bindings.name + , Core.declAccess = Core.private + , Core.valueEnc = Nothing + , Core.valueValue = foldr Core.Lam @bindings.core (@dictionaries ++ @ids) + , Core.declCustoms = toplevelType @bindings.name @lhs.importEnv @lhs.isTopLevel + } + ] + -- range : Range + -- bindings : FunctionBindings -- should all be for the same function + + | PatternBinding lhs.patBindNr = @lhs.patBindNr + 1 + loc.dictionaries = + case @pattern.self of + Pattern_Variable _ n -> + map predicateToId + (getPredicateForDecl n @lhs.dictionaryEnv) + _ -> [] + lhs.decls = + case @pattern.self of + Pattern_Variable _ n -> + [ Core.DeclValue + { Core.declName = idFromName n + , Core.declAccess = Core.private + , Core.valueEnc = Nothing + , Core.valueValue = + foldr Core.Lam + ( let_ -- because guards can fail + nextClauseId (patternMatchFail "pattern binding" @range.self) + @righthandside.core + ) + @dictionaries + , Core.declCustoms = toplevelType n @lhs.importEnv @lhs.isTopLevel + } + ] + _ -> + Core.DeclValue + { Core.declName = patBindId + , Core.declAccess = Core.private + , Core.valueEnc = Nothing + , Core.valueValue = + let_ + nextClauseId (patternMatchFail "pattern binding" @range.self) + @righthandside.core + , Core.declCustoms = [custom "type" "patternbinding"] + } + : + [ Core.DeclValue + { Core.declName = idFromName v + , Core.declAccess = Core.private + , Core.valueEnc = Nothing + , Core.valueValue = + (let_ nextClauseId (patternMatchFail "pattern binding" @range.self) + (patternToCore (patBindId, @pattern.self) (Core.Var (idFromName v))) + ) + , Core.declCustoms = toplevelType v @lhs.importEnv @lhs.isTopLevel + } + | v <- @pattern.vars + ] + where + patBindId = idFromString ("patBind$" ++ show @lhs.patBindNr) + -- range : Range + -- pattern : Pattern + -- righthandside : RightHandSide + + | TypeSignature lhs.decls = [] + -- range : Range + -- names : Names + -- type : Type -- may have context + + | Fixity lhs.decls = + map + ( ( \n -> + Core.DeclCustom + { Core.declName = idFromString n + , Core.declAccess = Core.private + , Core.declKind = (Core.DeclKindCustom . idFromString) "infix" + , Core.declCustoms = + [ Core.CustomInt + ( case @priority.self of + MaybeInt_Just i -> i + MaybeInt_Nothing -> 9 ) + , (Core.CustomBytes . bytesFromString) + ( case @fixity.self of + Fixity_Infixr _ -> "right" + Fixity_Infixl _ -> "left" + Fixity_Infix _ -> "none" + -- _ -> internalError + -- "ToCoreDecl.ag" + -- "SEM Declaration.Fixity" + -- "unknown fixity" + ) + ] + } + ) + . + getNameName + ) + @operators.self + -- range : Range + -- fixity : Fixity + -- priority : MaybeInt + -- operators : Names + + -- Not supported + + | Newtype lhs.decls = internalError "ToCoreDecl" "Declaration" "'newType' not supported" + constructor.tag = 0 + constructor.dataTypeName = @simpletype.name + -- range : Range + -- context : ContextItems + -- simpletype : SimpleType + -- constructor : Constructor -- has only one field, no strictness + -- derivings : Names + + | Class lhs.decls = internalError "ToCoreDecl" "Declaration" "'class' not supported" + -- range : Range + -- context : ContextItems -- is a "simple" context + -- simpletype : SimpleType -- Haskell 98 allows only one variable + -- where : MaybeDeclarations -- cannot have everything + + | Instance lhs.decls = internalError "ToCoreDecl" "Declaration" "'instance' not supported" + -- range : Range + -- context : ContextItems -- is a "simple" context + -- name : Name + -- types : Types -- Haskell 98 allows only one type + -- that is severely restricted + -- where : MaybeDeclarations -- cannot have everything + + | Default lhs.decls = internalError "ToCoreDecl" "Declaration" "'default' not supported" + -- range : Range + -- types : Types -- should be instances of Num + + | Empty lhs.decls = internalError "ToCoreDecl" "Declaration" "empty declarations not supported" + -- range : Range + +ATTR FunctionBinding FunctionBindings + [ ids : { [Id] } + | + | arity : Int + ] + +SEM FunctionBindings [ range : Range | | core : {Core.Expr} ] + | Cons lhs.core = @hd.core @tl.core + .arity = @hd.arity + | Nil lhs.core = patternMatchFail "function bindings" @lhs.range + .arity = internalError "ToCoreDecl" "FunctionBindings" "arity: empty list of function bindings" + +SEM FunctionBinding [ | | core : { Core.Expr -> Core.Expr } ] + | Hole lhs.arity = 0 + . core = internalError "ToCoreDecl" "FunctionBinding" "holes not supported" + | FunctionBinding lhs.arity = @lefthandside.arity + lhs.core = + \nextClause -> + let thisClause = + patternsToCore + (zip @lhs.ids @lefthandside.patterns) + @righthandside.core in + if all patternAlwaysSucceeds @lefthandside.patterns + && + not @righthandside.isGuarded + then + thisClause + else + let_ nextClauseId nextClause thisClause + + -- range : Range + -- lefthandside : LeftHandSide + -- righthandside : RightHandSide + +{ +predicateToId :: Predicate -> Id +predicateToId (Predicate class_ tp) = + idFromString $ "$dict" ++ class_ ++ show tp + +dictionaryTreeToCore :: DictionaryTree -> Core.Expr +dictionaryTreeToCore theTree = + case theTree of + ByPredicate predicate -> + Core.Var (predicateToId predicate) + ByInstance className instanceName trees -> + foldl Core.Ap + (Core.Var (idFromString ("$dict"++className++instanceName))) + (map dictionaryTreeToCore trees) + BySuperClass subClass superClass tree -> + Core.Ap (Core.Var (idFromString ("$get" ++ superClass ++ "From" ++ subClass))) + (dictionaryTreeToCore tree) + +insertDictionaries :: Name -> DictionaryEnvironment -> Core.Expr +insertDictionaries name dictionaryEnv = + foldl Core.Ap + (Core.Var (idFromName name)) + (map dictionaryTreeToCore (getDictionaryTrees name dictionaryEnv)) +} + +ATTR LeftHandSide + [ + | + | arity : Int + patterns : Patterns + ] + +SEM LeftHandSide + | Function lhs.arity = @patterns.length + .patterns = @patterns.self + -- range : Range + -- name : Name + -- patterns : Patterns + + | Infix lhs.arity = 2 + .patterns = [@leftPattern.self, @rightPattern.self ] + -- range : Range + -- leftPattern : Pattern + -- operator : Name + -- rightPattern : Pattern + + | Parenthesized lhs.arity = @lefthandside.arity + @patterns.length + .patterns = @lefthandside.patterns ++ @patterns.self + -- range : Range + -- lefthandside : LeftHandSide + -- patterns : Patterns + +SEM RightHandSide + [ + | + | core : { Core.Expr } + isGuarded : Bool + ] + + | Expression lhs.core = @where.core @expression.core + .isGuarded = False + -- range : Range + -- expression : Expression + -- where : MaybeDeclarations + + | Guarded lhs.isGuarded = True + .core = + @where.core (foldr ($) (Core.Var nextClauseId) @guardedexpressions.core) + + -- range : Range + -- guardedexpressions : GuardedExpressions + -- where : MaybeDeclarations + +-- ------------------------------------------------------------------------ +-- -- Types -- +-- ------------------------------------------------------------------------ + +ATTR Constructors Constructor + [ tag : Int + | + | cons USE { ++ } { [] } : { [(Id, CoreDecl)] } + ] + +SEM Constructors [ dataTypeName : Name | | ] + | Cons hd.tag = @lhs.tag + tl.tag = @lhs.tag + 1 + +SEM Constructor [ dataTypeName : Name | | ] + | Constructor lhs.cons = + [ (idFromName @constructor.self, Core.DeclCon + { Core.declName = idFromName @constructor.self + , Core.declAccess = Core.private + , Core.declArity = @types.length + , Core.conTag = @lhs.tag + , Core.declCustoms = constructorCustoms + @lhs.dataTypeName + @constructor.self + (valueConstructors @lhs.importEnv) + } + ) + ] + -- range : Range + -- constructor : Name + -- types : AnnotatedTypes + + | Infix lhs.cons = + [ (idFromName @constructorOperator.self, Core.DeclCon + { Core.declName = idFromName @constructorOperator.self + , Core.declAccess = Core.private + , Core.declArity = 2 + , Core.conTag = @lhs.tag + , Core.declCustoms = constructorCustoms + @lhs.dataTypeName + @constructorOperator.self + (valueConstructors @lhs.importEnv) + } + ) + ] + -- range : Range + -- leftType : AnnotatedType + -- constructorOperator : Name + -- rightType : AnnotatedType + +-- Not supported + + | Record lhs.cons = internalError "ToCoreDecl" "Constructor" "records not supported" + -- range : Range + -- constructor : Name + -- fieldDeclarations : FieldDeclarations + +SEM AnnotatedTypes [ | | length : Int ] + | Cons lhs.length = 1 + @tl.length + | Nil lhs.length = 0 + +{ +toplevelType :: Name -> ImportEnvironment -> Bool -> [Core.Custom] +toplevelType name ie isTopLevel + | isTopLevel = [custom "type" typeString] + | otherwise = [] + where + typeString = maybe + (internalError "ToCoreDecl" "Declaration" ("no type found for " ++ getNameName name)) + show + (M.lookup name (typeEnvironment ie)) + +constructorCustoms :: Name -> Name -> ValueConstructorEnvironment -> [Core.Custom] +constructorCustoms dataTypeName name env = + maybe + (internalError "ToCoreDecl" "Constructor" ("no type found for " ++ show name)) + (\tpScheme -> + [ custom "type" (show tpScheme) + , Core.CustomLink + (idFromName dataTypeName) + (Core.DeclKindCustom (idFromString "data")) + ] + ) + (M.lookup name env) +} diff --git a/src/Helium/CodeGeneration/ToCoreExpr.ag b/src/Helium/CodeGeneration/ToCoreExpr.ag new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/ToCoreExpr.ag @@ -0,0 +1,326 @@ +-- ------------------------------------------------------------------------ +-- -- Expressions -- +-- ------------------------------------------------------------------------ + +SEM MaybeExpression [ | | core : { Maybe Core.Expr } ] + | Nothing lhs.core = Nothing + | Just lhs.core = Just @expression.core + -- expression : Expression + + +ATTR Expressions [ | | core USE { : } { [] } : { [Core.Expr] } ] + +SEM Expression [ | | core : { Core.Expr } ] + | Literal lhs.core = @literal.core + -- range : Range + -- literal : Literal + + | Variable lhs.core = insertDictionaries @name.self @lhs.dictionaryEnv + -- range : Range + -- name : Name + + | Hole lhs.core = Core.Var (idFromString "undefined") + -- range : Range + -- id : Integer + + | Constructor lhs.core = Core.Con (Core.ConId (idFromName @name.self)) + -- range : Range + -- name : Name + + | Parenthesized lhs.core = @expression.core + -- range : Range + -- expression : Expression + + | NormalApplication lhs.core = foldl Core.Ap @function.core @arguments.core + -- range : Range + -- function : Expression + -- arguments : Expressions + + | InfixApplication lhs.core = + case (@leftExpression.core, @rightExpression.core) of + (Nothing, Nothing) -> @operator.core + (Just l , Nothing) -> Core.Ap @operator.core l + (Nothing, Just r ) -> Core.Lam parameterId + (foldl Core.Ap @operator.core [Core.Var parameterId, r]) + {- + -- At most one new variable is needed. Consider + -- (. (+ 3)) == \x -> (.) x (\x -> (+) x 3) + -} + (Just l , Just r ) -> foldl Core.Ap @operator.core [l,r] + -- range : Range + -- leftExpression : MaybeExpression + -- operator : Expression + -- rightExpression : MaybeExpression + + | If lhs.core = + if_ @guardExpression.core @thenExpression.core @elseExpression.core + -- range : Range + -- guardExpression : Expression + -- thenExpression : Expression + -- elseExpression : Expression + + | Lambda lhs.core = + let ids = freshIds "u$" @patterns.length + in let_ nextClauseId (patternMatchFail "lambda expression" @range.self) + (foldr + Core.Lam + (patternsToCore + (zip ids @patterns.self) + @expression.core + ) + ids + ) + -- range : Range + -- patterns : Patterns + -- expression : Expression + + | Case lhs.core = let_ caseExprId @expression.core @alternatives.core + alternatives.caseRange = @range.self + -- range : Range + -- expression : Expression + -- alternatives : Alternatives + + | Let declarations.patBindNr = 0 + declarations.isTopLevel = False + lhs.core = + letrec_ @declarations.decls @expression.core + -- range : Range + -- declarations : Declarations + -- expression : Expression + + | Do lhs.core = chainCode @statements.core + -- range : Range + -- statements : Statements + + | List lhs.core = coreList @expressions.core + -- range : Range + -- expressions : Expressions + + | Tuple lhs.core = + foldl + Core.Ap + (Core.Con + (Core.ConTag + (Core.Lit (Core.LitInt 0)) + (length @expressions.core) + ) + ) + @expressions.core + -- range : Range + -- expressions : Expressions + + | Comprehension lhs.core = + let singleton x = cons x nil + in foldr ($) (singleton @expression.core) @qualifiers.core + -- range : Range + -- expression : Expression + -- qualifiers : Qualifiers + + | Typed lhs.core = @expression.core + -- range : Range + -- expression : Expression + -- type : Type + + -- negate is overloaded and we need to insert a dictionary argument + | Negate lhs.core = insertDictionaries (setNameRange intUnaryMinusName @range.self) @lhs.dictionaryEnv + `app_` @expression.core + -- range : Range + -- expression : Expression + + | NegateFloat lhs.core = + var "$primNegFloat" `app_` @expression.core + -- range : Range + -- expression : Expression + + -- enumerations are overloaded and we need to insert a dictionary argument + | Enum lhs.core = + case (@then.core, @to.core) of + (Just then_, Just to) -> + insertDictionaries (setNameRange enumFromThenToName @range.self) @lhs.dictionaryEnv + `app_` @from.core `app_` then_ `app_` to + (Just then_, Nothing) -> + insertDictionaries (setNameRange enumFromThenName @range.self) @lhs.dictionaryEnv + `app_` @from.core `app_` then_ + (Nothing, Just to) -> + insertDictionaries (setNameRange enumFromToName @range.self) @lhs.dictionaryEnv + `app_` @from.core `app_` to + (Nothing, Nothing) -> + insertDictionaries (setNameRange enumFromName @range.self) @lhs.dictionaryEnv + `app_` @from.core + + -- range : Range + -- from : Expression + -- then : MaybeExpression + -- to : MaybeExpression + + | RecordConstruction lhs.core = internalError "ToCoreExpr" "Expression" "records not supported" + -- range : Range + -- name : Name + -- recordExpressionBindings : RecordExpressionBindings + + | RecordUpdate lhs.core = internalError "ToCoreExpr" "Expression" "records not supported" + -- range : Range + -- expression : Expression + -- recordExpressionBindings : RecordExpressionBindings + + +ATTR Statements [ | | core USE { : } { [] } : { [Maybe Core.Expr -> Core.Expr] } ] + +SEM Statement [ | | core : { Maybe Core.Expr -> Core.Expr } ] + | Expression lhs.core = + \theRest -> + case theRest of + Nothing -> @expression.core + Just rest -> bind @expression.core (Core.Lam dummyId rest) + -- range : Range + -- expression : Expression + + | Let declarations.patBindNr = 0 + declarations.isTopLevel = False + lhs.core = + \theRest -> + case theRest of + Nothing -> internalError "ToCoreExpr" "Statement" "'let' can't be last in 'do'" + Just rest -> letrec_ @declarations.decls rest + -- range : Range + -- declarations : Declarations + + -- let _nextClause = in + -- let _ok = \_misc -> case _misc of { pattern -> ...; _ -> _nextClause } + -- in expression >>= ok + | Generator lhs.core = + \theRest -> case theRest of + Nothing -> internalError "ToCoreExpr" "Statement" "generator can't be last in 'do'" + Just rest -> + let_ nextClauseId (patternMatchFail "generator" @range.self) + (let_ + okId + (Core.Lam parameterId + (patternToCore (parameterId, @pattern.self) rest) + ) + (@expression.core `bind` Core.Var okId) + ) + -- range : Range + -- pattern : Pattern + -- expression : Expression + +-- Not supported + + | Empty lhs.core = + \theRest -> + case theRest of + Nothing -> internalError "ToCoreExpr" "Statement" "empty statements not supported" + Just rest -> rest + -- range : Range + + + +ATTR Qualifiers [ | | core USE { : } { [] } : { [Core.Expr -> Core.Expr] } ] + +SEM Qualifier [ | | core : { Core.Expr -> Core.Expr } ] + | Guard lhs.core = \continue -> if_ @guard.core continue nil + -- range : Range + -- guard : Expression -- type: Boolean + + | Let declarations.patBindNr = 0 + declarations.isTopLevel = False + lhs.core = \continue -> letrec_ @declarations.decls continue + -- range : Range + -- declarations : Declarations + + -- See Haskell report 3.11 + -- let _nextClause = [] in + -- let _ok = \_misc -> case _misc of { pattern -> ...; _ -> _nextClause } + -- in concatMap _ok expression + + | Generator lhs.core = + \continue -> + let_ nextClauseId nil + (let_ + okId + (Core.Lam parameterId + (patternToCore (parameterId, @pattern.self) continue) + ) + (var "$primConcatMap" + `app_` Core.Var okId + `app_` @expression.core + ) + ) + -- range : Range + -- pattern : Pattern + -- expression : Expression + +-- Not supported + + | Empty lhs.core = internalError "ToCoreExpr" "Qualifier" "empty qualifiers not supported" + -- range : Range + +SEM Alternatives [ caseRange : Range | | core : { Core.Expr } ] + | Cons lhs.core = @hd.core @tl.core + | Nil lhs.core = patternMatchFail "case expression" @lhs.caseRange + +SEM Alternative [ | | core : { Core.Expr -> Core.Expr } ] + | Hole lhs.core = id + | Alternative lhs.core = \nextCase -> + let thisCase = + patternToCore + (caseExprId, @pattern.self) + @righthandside.core + in + let_ nextClauseId nextCase thisCase + -- range : Range + -- pattern : Pattern + -- righthandside : RightHandSide + + | Empty lhs.core = id + -- range : Range + +ATTR GuardedExpressions [ | | core USE { : } { [] } : { [Core.Expr -> Core.Expr] } ] + +SEM GuardedExpression [ | | core : { Core.Expr -> Core.Expr } ] + | GuardedExpression lhs.core = + \fail' -> if_ @guard.core @expression.core fail' + -- range : Range + -- guard : Expression -- type: Boolean + -- expression : Expression + +SEM Literal [ | | core : { Core.Expr } ] + | Int lhs.core = Core.Lit (Core.LitInt (read @value)) + -- range : Range + -- value : String + + | Char lhs.core = + Core.Lit (Core.LitInt (ord + (read ("'" ++ @value ++ "'")))) + -- range : Range + -- value : String -- without the quotes + + | Float lhs.core = float @value + -- range : Range + -- value : String + + | String lhs.core = + var "$primPackedToString" `app_` + packedString (read ("\"" ++ @value ++ "\"")) + -- range : Range + -- value : String -- without the quotes + +{ + +-- Function "bind" is used in the translation of do-expressions +bind :: Core.Expr -> Core.Expr -> Core.Expr +bind ma f = Core.Var primBindIOId `app_` ma `app_` f + +primBindIOId, caseExprId, okId, parameterId :: Id +( primBindIOId : caseExprId : okId : parameterId : []) = map idFromString $ + "$primBindIO" : "caseExpr$" : "ok$" : "parameter$" : [] + +-- Function "chainCode" is used in the translation of do-expressions +chainCode :: [Maybe Core.Expr -> Core.Expr] -> Core.Expr +chainCode theCores = + case theCores of + [core] -> core Nothing + (core:cores) -> core (Just (chainCode cores)) + [] -> error "pattern match failure in CodeGeneration.ToCoreExpr.chainCode" +} + diff --git a/src/Helium/CodeGeneration/ToCoreModule.ag b/src/Helium/CodeGeneration/ToCoreModule.ag new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/ToCoreModule.ag @@ -0,0 +1,165 @@ +-- ------------------------------------------------------------------------ +-- -- Modules -- +-- ------------------------------------------------------------------------ + +imports{ +import Lvm.Common.Byte(bytesFromString) +} + +{ +makeCoreModule :: Maybe Id -> [Module.Decl v] -> Module.Module v +makeCoreModule name decls = + Module.Module + { Module.moduleName = + case name of + Nothing -> idFromString "Main" + Just n -> n + , Module.moduleMajorVer = 0 + , Module.moduleMinorVer = 0 + , Module.moduleDecls = decls + } + +interpreterMain :: String +interpreterMain = "interpreter_main" + +-- Unfortunately we need a hack for the interpreter +-- The interpreter_main has te be wrapped inside unsafePerformIO etcetera, too +-- We can't just call it main because we'll get import clashes. Sigh! + +insertedMain :: TypeEnvironment -> CoreDecl +insertedMain toplevelTypes = + let maybeWrapMainAndType = + case M.lookup (Name_Identifier noRange [] "main") toplevelTypes of -- !!!Name + Just t -> Just ("main", t) + Nothing -> + case M.lookup (Name_Identifier noRange [] interpreterMain) toplevelTypes of -- !!!Name + Just t -> Just (interpreterMain, t) + Nothing -> Nothing + in + decl False "main$" $ + app_ unsafePIO $ + case maybeWrapMainAndType of + Nothing -> + var "$primPutStrLn" `app_` + (var "$primPackedToString" `app_` + packedString "No 'main' function defined in this module") + Just (name, tpScheme) + | not (null qs) -> + var "$primPutStrLn" `app_` + (var "$primPackedToString" `app_` + packedString "<>") + | isIOType tp -> + var name + | otherwise -> + var "$primPutStrLn" `app_` + (DerivingShow.showFunctionOfType True (makeTypeFromTp tp) `app_` + var name) + where + (qs, tp) = split (snd (instantiate 123456789 tpScheme)) + where + unsafePIO = var "$primUnsafePerformIO" + +} + +SEM Module + | Module -- insert "insertedMain" after modulePublic so that it remains private + lhs.core = @module_ { Module.moduleDecls = + insertedMain @lhs.toplevelTypes : Module.moduleDecls @module_ } + loc.module_ = + + everythingPublicButPrelude + (makeCoreModule (fmap idFromName @name.name) + ( @body.decls ++ @lhs.extraDecls + )) + +{ +-- set the public bit of all declarations except those that are imported from +-- Prelude or HeliumLang. I.e. export everything everywhere +everythingPublicButPrelude :: Core.CoreModule -> Core.CoreModule +everythingPublicButPrelude theModule = theModule { Core.moduleDecls = map setPublic (Core.moduleDecls theModule) } + where + setPublic declaration = + let -- accessRecord = Core.declAccess decl + public = case Core.declAccess declaration of + Core.Defined _ -> True + Core.Imported { Core.importModule = m } -> + stringFromId m `notElem` ["Prelude", "HeliumLang"] + in + declaration{ Core.declAccess = + (Core.declAccess declaration){ Core.accessPublic = public } } +} + +{- +{ +-- Return all local value definitions that start with a '$' in the name +localValuePrims :: [CoreDecl] -> IdSet +localValuePrims cdecls + = setFromList [declName decl | decl <- cdecls + , isDeclValue decl + , let name = stringFromId (declName decl) + , not (null name) + , head name == '$' + ] + +} +-} + -- range : Range + -- name : MaybeName + -- exports : MaybeExports + -- body : Body +-- Since the parser cannot distinguish between types or constructors, +-- or between types and type classes, we do not have different cases (yet?). + +ATTR Declarations Declaration + [ isTopLevel : Bool + | + | + ] + + +ATTR MaybeExports Export Exports + [ + | + | values, types, cons, mods USE { `unionSet` } { emptySet } : {IdSet} + ] + +SEM Export + | Variable lhs.values = singleSet (idFromName @name.self) + .types = emptySet + .cons = emptySet + .mods = emptySet + -- range : Range + -- name : Name + | TypeOrClass lhs.values = emptySet + .types = singleSet (idFromName @name.self) + .cons = setFromList (maybe [] (map idFromName) @names.names) + .mods = emptySet + -- range : Range + -- name : Name + -- names : MaybeNames -- constructors or field names or class methods + | TypeOrClassComplete lhs.values = internalError "ToCoreModule" "exports.tocc" "Unsupported export declaration" + .types = internalError "ToCoreModule" "exports.tocc" "Unsupported export declaration" + .cons = internalError "ToCoreModule" "exports.tocc" "Unsupported export declaration" + .mods = internalError "ToCoreModule" "exports.tocc" "Unsupported export declaration" + -- range : Range + -- name : Name + | Module lhs.values = emptySet + .types = emptySet + .cons = emptySet + .mods = singleSet (idFromName @name.self) + -- range : Range + -- name : Name -- this is a module name + +ATTR Body Declarations Declaration + [ + | + | decls USE { ++ } { [] } : { [CoreDecl] } + ] + +SEM Body + | Body lhs.decls = @declarations.decls + declarations.patBindNr = 0 + declarations.isTopLevel = True + -- range : Range + -- importdeclarations : ImportDeclarations + -- declarations : Declarations diff --git a/src/Helium/CodeGeneration/ToCoreName.ag b/src/Helium/CodeGeneration/ToCoreName.ag new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/ToCoreName.ag @@ -0,0 +1,30 @@ +SEM MaybeName [ | | isNothing : Bool name : { Maybe Name } ] + | Nothing lhs.isNothing = True + lhs.name = Nothing + | Just lhs.isNothing = False + lhs.name = Just @name.self + -- name : Name + +SEM MaybeNames [ | | names : { Maybe [Name] } ] + | Nothing lhs.names = Nothing + | Just lhs.names = Just @names.names + -- name : Name + +ATTR Names [ | | names : {[Name]} ] + +SEM Names + | Cons lhs.names = @hd.self : @tl.names + | Nil lhs.names = [] + +ATTR FunctionBinding FunctionBindings LeftHandSide [ | | name:Name ] + +SEM FunctionBindings + | Cons lhs . name = @hd.name + | Nil lhs . name = internalError "ToCoreName.ag" "n/a" "empty FunctionBindings" + +SEM FunctionBinding + | Hole lhs . name = internalError "ToCoreName.ag" "n/a" "hole FunctionBindings" + +SEM LeftHandSide + | Function lhs . name = @name.self + | Infix lhs . name = @operator.self diff --git a/src/Helium/CodeGeneration/ToCorePat.ag b/src/Helium/CodeGeneration/ToCorePat.ag new file mode 100644 --- /dev/null +++ b/src/Helium/CodeGeneration/ToCorePat.ag @@ -0,0 +1,50 @@ +ATTR Patterns + [ + | + | length : Int + ] + +ATTR Pattern Patterns + [ + | + | vars USE { ++ } { [] } : { [Name] } + ] + +SEM Patterns + | Cons lhs.length = 1 + @tl.length + | Nil lhs.length = 0 + + +SEM Pattern + | Variable lhs.vars = [ @name.self ] + -- range : Range + -- name : Name + + | As lhs.vars = @name.self : @pattern.vars + -- range : Range + -- name : Name + -- pattern : Pattern + +{ + +patternAlwaysSucceeds :: Pattern -> Bool +patternAlwaysSucceeds p = + case p of + Pattern_Variable _ _ -> True + Pattern_Wildcard _ -> True + Pattern_As _ _ pat -> patternAlwaysSucceeds pat + Pattern_Parenthesized _ pat -> patternAlwaysSucceeds pat + _ -> False + +patternMatchFail :: String -> Range -> Core.Expr +patternMatchFail nodeDescription range = + var "$primPatternFailPacked" + `app_` packedString ( + nodeDescription ++ " ranging from " ++ + showPosition start ++ " to " ++ + showPosition (getRangeEnd range) ++ " in module " ++ + moduleFromPosition start + ) + where + start = getRangeStart range +} diff --git a/src/Helium/Main.hs b/src/Helium/Main.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main.hs @@ -0,0 +1,180 @@ +{-| Module : Main + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} +module Main where + +import Helium.Main.Compile(compile) +import Helium.Parser.Parser(parseOnlyImports) +import Control.Monad +import System.FilePath(joinPath) +import Data.List(nub, elemIndex, isSuffixOf, intercalate) +import Data.Maybe(fromJust) +import Lvm.Path(explodePath,getLvmPath) +import System.Directory(doesFileExist, getModificationTime) +import Helium.Main.Args +import Helium.Main.CompileUtils +import Data.IORef +import Paths_helium + +-- Prelude will be treated specially +prelude :: String +prelude = "Prelude.hs" + +-- Order matters +coreLibs :: [String] +coreLibs = ["LvmLang", "LvmIO", "LvmException", "HeliumLang", "PreludePrim"] + +main :: IO () +main = do + args <- getArgs + (options, Just fullName) <- processHeliumArgs args -- Can't fail, because processHeliumArgs checks it. + + lvmPathFromOptionsOrEnv <- case lvmPathFromOptions options of + Nothing -> getLvmPath + Just s -> return (explodePath s) + + -- Choose the right libraries to use based on whether overloading is turned off or on + baseLibs <- getDataFileName $ + if overloadingFromOptions options + then "lib" + else joinPath ["lib","simple"] + + let (filePath, moduleName, _) = splitFilePath fullName + filePath' = if null filePath then "." else filePath + lvmPath = filter (not.null) . nub + $ (filePath' : lvmPathFromOptionsOrEnv) ++ [baseLibs] -- baseLibs always last + + -- File that is compiled must exist, this test doesn't use the search path + fileExists <- doesFileExist fullName + newFullName <- + if fileExists then + return fullName + else do + let filePlusHS = fullName ++ ".hs" + filePlusHSExists <- doesFileExist filePlusHS + unless filePlusHSExists $ do + putStrLn $ "Can't find file " ++ show fullName ++ " or " ++ show filePlusHS + exitWith (ExitFailure 1) + return filePlusHS + + -- Ensure .core libs are compiled to .lvm + mapM_ (makeCoreLib baseLibs) coreLibs + -- And now deal with Prelude + preludeRef <- newIORef [] + _ <- make filePath' (joinPath [baseLibs,prelude]) lvmPath [prelude] options preludeRef + + doneRef <- newIORef [] + _ <- make filePath' newFullName lvmPath [moduleName] options doneRef + return () + + + +-- fullName = file name including path of ".hs" file that is to be compiled +-- lvmPath = where to look for files +-- chain = chain of imports that led to the current module +-- options = the compiler options +-- doneRef = an IO ref to a list of already compiled files +-- (their names and whether they were recompiled or not) +-- returns: recompiled or not? (true = recompiled) +make :: String -> String -> [String] -> [String] -> [Option] -> IORef [(String, Bool)] -> IO Bool +make basedir fullName lvmPath chain options doneRef = + do + -- If we already compiled this module, return the result we already now + done <- readIORef doneRef + + case lookup fullName done of + Just isRecompiled -> return isRecompiled + Nothing -> do + + imports <- parseOnlyImports fullName + + -- If this module imports a module earlier in the chain, there is a cycle + case circularityCheck imports chain of + Just cycl -> do + putStrLn $ "Circular import chain: \n\t" ++ showImportChain cycl ++ "\n" + exitWith (ExitFailure 1) + Nothing -> + return () + + -- Find all imports in the search path + resolvedImports <- mapM (resolve lvmPath) imports + + -- For each of the imports... + compileResults <- forM (zip imports resolvedImports) + $ \(importModuleName, maybeImportFullName) -> do + + -- Issue error if import can not be found in the search path + case maybeImportFullName of + Nothing -> do + putStrLn $ + "Can't find module '" ++ importModuleName ++ "'\n" ++ + "Import chain: \n\t" ++ showImportChain (chain ++ [importModuleName]) ++ + "\nSearch path:\n" ++ showSearchPath lvmPath + exitWith (ExitFailure 1) + Just _ -> return () + + let importFullName = fromJust maybeImportFullName + -- TODO : print names imported modules in verbose mode. + + -- If we only have an ".lvm" file we do not need to (/can't) recompile + if ".lvm" `isSuffixOf` importFullName then + return False + else + make basedir importFullName lvmPath (chain ++ [importModuleName]) options doneRef + + -- Recompile the current module if: + -- * any of the children was recompiled + -- * the build all option (-B) was on the command line + -- * the build one option (-b) was there and we are + -- compiling the top-most module (head of chain) + -- * the module is not up to date (.hs newer than .lvm) + let (filePath, moduleName, _) = splitFilePath fullName + upToDate <- upToDateCheck (combinePathAndFile filePath moduleName) + newDone <- readIORef doneRef + isRecompiled <- + if or compileResults || + BuildAll `elem` options || + (BuildOne `elem` options && moduleName == head chain) || + not upToDate + then do + compile basedir fullName options lvmPath (map fst newDone) + return True + else do + putStrLn (moduleName ++ " is up to date") + return False + + -- Remember the fact that we have already been at this module + writeIORef doneRef ((fullName, isRecompiled):newDone) + return isRecompiled + +showImportChain :: [String] -> String +showImportChain = intercalate " imports " + +showSearchPath :: [String] -> String +showSearchPath = unlines . map ("\t" ++) + +preludeImportsPrelude :: [String] -> Bool +preludeImportsPrelude [x,y] = x == prelude && y == prelude +preludeImportsPrelude _ = False + +circularityCheck :: [String] -> [String] -> Maybe [String] +circularityCheck (import_:imports) chain = + case elemIndex import_ chain of + Just index -> Just (drop index chain ++ [import_]) + Nothing -> circularityCheck imports chain +circularityCheck [] _ = Nothing + +-- | upToDateCheck returns true if the .lvm is newer than the .hs +upToDateCheck :: String -> IO Bool +upToDateCheck basePath = do + lvmExists <- doesFileExist (basePath ++ ".lvm") + if lvmExists then do + t1 <- getModificationTime (basePath ++ ".hs") + t2 <- getModificationTime (basePath ++ ".lvm") + return (t1 < t2) + else + return False diff --git a/src/Helium/Main/Args.hs b/src/Helium/Main/Args.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/Args.hs @@ -0,0 +1,322 @@ +{-| Module : Args + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + +-} + +module Helium.Main.Args + ( Option(..) + , processHeliumArgs + , processRunHeliumArgs + , processTexthintArgs + , lvmPathFromOptions + , loggerDEFAULTHOST + , simplifyOptions + , argsToOptions + , loggerDEFAULTPORT + , hostFromOptions + , portFromOptions + , overloadingFromOptions + , hasAlertOption + ) where + +import System.Exit +import System.FilePath +import Helium.Main.Version +import Data.Maybe +import Control.Monad(when) +import System.Console.GetOpt +import Data.Char + +loggerDEFAULTHOST :: String +loggerDEFAULTHOST = "helium.zoo.cs.uu.nl" + +loggerDEFAULTPORT :: Int +loggerDEFAULTPORT = 5010 + +unwordsBy :: String -> [String] -> String +unwordsBy _ [] = "" +unwordsBy _ [w] = w +unwordsBy sep (w:ws) = w ++ sep ++ unwordsBy sep ws + +-- Keep only the last of the overloading flags and the last of the logging enable flags. +-- The alert flag overrides logging turned off. +-- This function also collects all -P flags together and merges them into one. The order of the +-- directories is the order in which they were specified. +simplifyOptions :: [Option] -> [Option] +simplifyOptions ops = + let + revdefops = reverse ops + modops = case alertMessageFromOptions revdefops of + (Just _) -> EnableLogging : revdefops -- Explicitly enable logging as well, just to be safe + Nothing -> revdefops + in + collectPaths (keepFirst [Overloading, NoOverloading] (keepFirst [EnableLogging, DisableLogging] modops)) [] [] + where + -- Assumes the options are in reverse order, and also reverses them. + -- Collects several LvmPath options into one + collectPaths [] paths newops = LvmPath (unwordsBy [searchPathSeparator] paths) : newops + collectPaths (LvmPath path : rest) paths newops + = collectPaths rest (path : paths) newops + collectPaths (opt : rest) paths newops + = collectPaths rest paths (opt : newops) + keepFirst _ [] = [] + keepFirst fromList (opt : rest) = if opt `elem` fromList then + opt : optionFilter fromList rest + else + opt : keepFirst fromList rest + optionFilter _ [] = [] + optionFilter fromList (opt : rest) = if opt `elem` fromList then + optionFilter fromList rest + else + opt : optionFilter fromList rest + +terminateWithMessage :: [Option] -> String -> [String] -> IO ([Option], Maybe String) +terminateWithMessage options message errors = do + let experimentalOptions = ExperimentalOptions `elem` options + let moreOptions = MoreOptions `elem` options || experimentalOptions + putStrLn message + putStrLn (unlines errors) + putStrLn $ "Helium compiler " ++ version + putStrLn (usageInfo "Usage: helium [options] file [options]" (optionDescription moreOptions experimentalOptions)) + exitWith (ExitFailure 1) + +processTexthintArgs :: [String] -> IO ([Option], Maybe String) +processTexthintArgs = basicProcessArgs [] + +processHeliumArgs :: [String] -> IO ([Option], Maybe String) +processHeliumArgs args = do + (options, maybeFiles) <- basicProcessArgs [DisableLogging, Overloading] args + case maybeFiles of + Nothing -> + terminateWithMessage options "Error in invocation: the name of the module to be compiled seems to be missing." [] + Just _ -> + return (options, maybeFiles) + +processRunHeliumArgs :: [String] -> IO ([Option], Maybe String) +processRunHeliumArgs args = do + (options, maybeFiles) <- basicProcessArgs [] args + case maybeFiles of + Nothing -> + terminateWithMessage options "Error in invocation: the name of the lvm file to be run seems to be missing." [] + Just _ -> + return (options, maybeFiles) + +-- Sometimes you know the options are correct. Then you can use this. +argsToOptions :: [String] -> [Option] +argsToOptions args = + let + (opts,_,_) = getOpt Permute (optionDescription True True) args + in + opts + +-- The Maybe String indicates that a file may be missing. Resulting options are simplified +basicProcessArgs :: [Option] -> [String] -> IO ([Option], Maybe String) +basicProcessArgs defaults args = + let (options, arguments, errors) = getOpt Permute (optionDescription True True) args + in if not (null errors) then + terminateWithMessage options "Error in invocation: list of parameters is erroneous.\nProblem(s):" + (map (" " ++) errors) + else + if length arguments > 1 then + terminateWithMessage options ("Error in invocation: only one non-option parameter expected, but found instead:\n" ++ unlines (map (" "++) arguments)) [] + else + do + let simpleOptions = simplifyOptions (defaults ++ options) + argument = if null arguments then Nothing else Just (head arguments) + when (Verbose `elem` simpleOptions) $ do + mapM_ putStrLn ("Options after simplification: " : map show simpleOptions) + putStrLn ("Argument: " ++ show argument) + return (simpleOptions, argument) + +optionDescription :: Bool -> Bool -> [OptDescr Option] +optionDescription moreOptions experimentalOptions = + -- Main options + [ Option "b" [flag BuildOne] (NoArg BuildOne) "recompile module even if up to date" + , Option "B" [flag BuildAll] (NoArg BuildAll) "recompile all modules even if up to date" + , Option "i" [flag DumpInformationForThisModule] (NoArg DumpInformationForThisModule) "show information about this module" + , Option "I" [flag DumpInformationForAllModules] (NoArg DumpInformationForAllModules) "show information about all imported modules" + , Option "" [flag EnableLogging] (NoArg EnableLogging) "enable logging, overrides previous disable-logging" + , Option "" [flag DisableLogging] (NoArg DisableLogging) "disable logging (default), overrides previous enable-logging flags" + , Option "a" [flag (Alert "")] (ReqArg Alert "MESSAGE") "compiles with alert flag in logging; MESSAGE specifies the reason for the alert." + , Option "" [flag Overloading] (NoArg Overloading) "turn overloading on (default), overrides all previous no-overloading flags" + , Option "" [flag NoOverloading] (NoArg NoOverloading) "turn overloading off, overrides all previous overloading flags" + , Option "P" [flag (LvmPath "")] (ReqArg LvmPath "PATH") "use PATH as search path" + , Option "v" [flag Verbose] (NoArg Verbose) "show the phase the compiler is in" + , Option "w" [flag NoWarnings] (NoArg NoWarnings) "do notflag warnings" + , Option "X" [flag MoreOptions] (NoArg MoreOptions) "show more compiler options" + , Option "" [flag (Information "")] (ReqArg Information "NAME") "display information about NAME" + + ] + ++ + -- More options + if not moreOptions then [] else + [ Option "1" [flag StopAfterParser] (NoArg StopAfterParser) "stop after parsing" + , Option "2" [flag StopAfterStaticAnalysis] (NoArg StopAfterStaticAnalysis) "stop after static analysis" + , Option "3" [flag StopAfterTypeInferencing] (NoArg StopAfterTypeInferencing) "stop after type inferencing" + , Option "4" [flag StopAfterDesugar] (NoArg StopAfterDesugar) "stop after desugaring into Core" + , Option "t" [flag DumpTokens] (NoArg DumpTokens) "dump tokens to screen" + , Option "u" [flag DumpUHA] (NoArg DumpUHA) "pretty print abstract syntax tree" + , Option "c" [flag DumpCore] (NoArg DumpCore) "pretty print Core program" + , Option "C" [flag DumpCoreToFile] (NoArg DumpCoreToFile) "write Core program to file" + , Option "" [flag DebugLogger] (NoArg DebugLogger) "show logger debug information" + , Option "" [flag (Host "")] (ReqArg Host "HOST") ("specify which HOST to use for logging (default " ++ loggerDEFAULTHOST ++ ")") + , Option "" [flag (Port 0)] (ReqArg selectPort "PORT") ("select the PORT number for the logger (default: " ++ show loggerDEFAULTPORT ++ ")") + , Option "d" [flag DumpTypeDebug] (NoArg DumpTypeDebug) "debug constraint-based type inference" + , Option "W" [flag AlgorithmW] (NoArg AlgorithmW) "use bottom-up type inference algorithm W" + , Option "M" [flag AlgorithmM ] (NoArg AlgorithmM) "use folklore top-down type inference algorithm M" + , Option "" [flag DisableDirectives] (NoArg DisableDirectives) "disable type inference directives" + , Option "" [flag NoRepairHeuristics] (NoArg NoRepairHeuristics) "don't suggest program fixes" + , Option "" [flag HFullQualification] (NoArg HFullQualification) "to determine fully qualified names for Holmes" + ] + ++ + -- Experimental options + if not experimentalOptions then [] else + [ Option "" [flag ExperimentalOptions] (NoArg ExperimentalOptions) "show experimental compiler options" + , Option "" [flag KindInferencing] (NoArg KindInferencing) "perform kind inference (experimental)" + , Option "" [flag SignatureWarnings] (NoArg SignatureWarnings) "warn for too specific signatures (experimental)" + , Option "" [flag RightToLeft] (NoArg RightToLeft) "right-to-left treewalk" + , Option "" [flag NoSpreading] (NoArg NoSpreading) "do not spread type constraints (experimental)" + , Option "" [flag TreeWalkTopDown] (NoArg TreeWalkTopDown) "top-down treewalk" + , Option "" [flag TreeWalkBottomUp] (NoArg TreeWalkBottomUp) "bottom up-treewalk" + , Option "" [flag TreeWalkInorderTopFirstPre] (NoArg TreeWalkInorderTopFirstPre) "treewalk (top;upward;child)" + , Option "" [flag TreeWalkInorderTopLastPre] (NoArg TreeWalkInorderTopLastPre) "treewalk (upward;child;top)" + , Option "" [flag TreeWalkInorderTopFirstPost] (NoArg TreeWalkInorderTopFirstPost) "treewalk (top;child;upward)" + , Option "" [flag TreeWalkInorderTopLastPost] (NoArg TreeWalkInorderTopLastPost) "treewalk (child;upward;top)" + , Option "" [flag SolverSimple] (NoArg SolverSimple) "a simple constraint solver" + , Option "" [flag SolverGreedy] (NoArg SolverGreedy) "a fast constraint solver" + , Option "" [flag SolverTypeGraph] (NoArg SolverTypeGraph) "type graph constraint solver" + , Option "" [flag SolverCombination] (NoArg SolverCombination) "switches between \"greedy\" and \"type graph\"" + , Option "" [flag SolverChunks] (NoArg SolverChunks) "solves chunks of constraints (default)" + , Option "" [flag UnifierHeuristics] (NoArg UnifierHeuristics) "use unifier heuristics (experimental)" + , Option "" [flag (SelectConstraintNumber 0)] (ReqArg selectCNR "CNR") "select constraint number to be reported" + , Option "" [flag NoOverloadingTypeCheck] (NoArg NoOverloadingTypeCheck) "disable overloading errors (experimental)" + , Option "" [flag NoPrelude] (NoArg NoPrelude) "do not import the prelude (experimental)" + ] + + +data Option + -- Main options + = BuildOne | BuildAll | DumpInformationForThisModule | DumpInformationForAllModules + | DisableLogging | EnableLogging | Alert String | Overloading | NoOverloading | LvmPath String | Verbose | NoWarnings | MoreOptions + | Information String + -- More options + | StopAfterParser | StopAfterStaticAnalysis | StopAfterTypeInferencing | StopAfterDesugar + | DumpTokens | DumpUHA | DumpCore | DumpCoreToFile + | DebugLogger | Host String | Port Int + | DumpTypeDebug | AlgorithmW | AlgorithmM | DisableDirectives | NoRepairHeuristics | HFullQualification + -- Experimental options + | ExperimentalOptions | KindInferencing | SignatureWarnings | RightToLeft | NoSpreading + | TreeWalkTopDown | TreeWalkBottomUp | TreeWalkInorderTopFirstPre | TreeWalkInorderTopLastPre + | TreeWalkInorderTopFirstPost | TreeWalkInorderTopLastPost | SolverSimple | SolverGreedy + | SolverTypeGraph | SolverCombination | SolverChunks | UnifierHeuristics + | SelectConstraintNumber Int | NoOverloadingTypeCheck | NoPrelude | UseTutor + deriving (Eq) + +stripShow :: String -> String +stripShow name = tail (tail (takeWhile ('=' /=) name)) + +flag :: Option -> String +flag = stripShow . show + +instance Show Option where + show BuildOne = "--build" + show BuildAll = "--build-all" + show DumpInformationForThisModule = "--dump-information" + show DumpInformationForAllModules = "--dump-all-information" + show EnableLogging = "--enable-logging" + show DisableLogging = "--disable-logging" + show (Alert str) = "--alert=\"" ++ str ++ "\"" -- May contain spaces + show Overloading = "--overloading" + show NoOverloading = "--no-overloading" + show (LvmPath str) = "--lvmpath=\"" ++ str ++ "\"" -- May contain spaces + show Verbose = "--verbose" + show NoWarnings = "--no-warnings" + show MoreOptions = "--moreoptions" + show (Information str) = "--info=" ++ str + show StopAfterParser = "--stop-after-parsing" + show StopAfterStaticAnalysis = "--stop-after-static-analysis" + show StopAfterTypeInferencing = "--stop-after-type-inferencing" + show StopAfterDesugar = "--stop-after-desugaring" + show DumpTokens = "--dump-tokens" + show DumpUHA = "--dump-uha" + show DumpCore = "--dump-core" + show DumpCoreToFile = "--save-core" + show DebugLogger = "--debug-logger" + show (Host host) = "--host=" ++ host + show (Port port) = "--port=" ++ show port + show DumpTypeDebug = "--type-debug" + show AlgorithmW = "--algorithm-w" + show AlgorithmM = "--algorithm-m" + show DisableDirectives = "--no-directives" + show NoRepairHeuristics = "--no-repair-heuristics" + show ExperimentalOptions = "--experimental-options" + show KindInferencing = "--kind-inferencing" + show SignatureWarnings = "--signature-warnings" + show RightToLeft = "--right-to-left" + show NoSpreading = "--no-spreading" + show TreeWalkTopDown = "--treewalk-topdown" + show TreeWalkBottomUp = "--treewalk-bottomup" + show TreeWalkInorderTopFirstPre = "--treewalk-inorder1" + show TreeWalkInorderTopLastPre = "--treewalk-inorder2" + show TreeWalkInorderTopFirstPost = "--treewalk-inorder3" + show TreeWalkInorderTopLastPost = "--treewalk-inorder4" + show SolverSimple = "--solver-simple" + show SolverGreedy = "--solver-greedy" + show SolverTypeGraph = "--solver-typegraph" + show SolverCombination = "--solver-combination" + show SolverChunks = "--solver-chunks" + show UnifierHeuristics = "--unifier-heuristics" + show (SelectConstraintNumber cnr) = "--select-cnr=" ++ show cnr + show HFullQualification = "--H-fullqualification" + show NoOverloadingTypeCheck = "--no-overloading-typecheck" + show NoPrelude = "--no-prelude" + show UseTutor = "--use-tutor" + + +lvmPathFromOptions :: [Option] -> Maybe String +lvmPathFromOptions [] = Nothing +lvmPathFromOptions (LvmPath s : _) = Just s +lvmPathFromOptions (_ : rest) = lvmPathFromOptions rest + +-- Assumes removed duplicates! +overloadingFromOptions :: [Option] -> Bool +overloadingFromOptions [] = error "Internal error in Args.overloadingFromOptions" +overloadingFromOptions (Overloading:_) = True +overloadingFromOptions (NoOverloading:_) = False +overloadingFromOptions (_:rest) = overloadingFromOptions rest + +-- Takes the first in the list. Better to remove duplicates! +hostFromOptions :: [Option] -> Maybe String +hostFromOptions [] = Nothing +hostFromOptions (Host s : _) = Just s +hostFromOptions (_ : rest) = hostFromOptions rest + +-- Takes the first in the list. Better to remove duplicates! +portFromOptions :: [Option] -> Maybe Int +portFromOptions [] = Nothing +portFromOptions (Port pn: _) = Just pn +portFromOptions (_ : rest) = portFromOptions rest + +-- Extracts the alert message. Returns Nothing if such is not present. +alertMessageFromOptions :: [Option] -> Maybe String +alertMessageFromOptions [] = Nothing +alertMessageFromOptions (Alert message: _) = Just message +alertMessageFromOptions (_ : rest) = alertMessageFromOptions rest + +hasAlertOption :: [Option] -> Bool +hasAlertOption = isJust . alertMessageFromOptions + +selectPort :: String -> Option +selectPort pn + | all isDigit pn = Port (read ('0':pn)) + | otherwise = Port (-1) -- problem with argument + +selectCNR :: String -> Option +selectCNR s + | all isDigit s = SelectConstraintNumber (read ('0':s)) + | otherwise = SelectConstraintNumber (-1) -- problem with argument + diff --git a/src/Helium/Main/Compile.hs b/src/Helium/Main/Compile.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/Compile.hs @@ -0,0 +1,132 @@ +{-| Module : Compile + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.Compile where + +import Helium.Main.PhaseLexer +import Helium.Main.PhaseParser +import Helium.Main.PhaseImport +import Helium.Main.PhaseResolveOperators +import Helium.Main.PhaseStaticChecks +import Helium.Main.PhaseKindInferencer +import Helium.Main.PhaseTypingStrategies +import Helium.Main.PhaseTypeInferencer +import Helium.Main.PhaseDesugarer +import Helium.Main.PhaseCodeGenerator +import Helium.Main.CompileUtils +import Helium.Utils.Utils +import qualified Control.Exception as CE (catch, IOException) +import Data.IORef +import Helium.StaticAnalysis.Messages.StaticErrors(errorsLogCode) + +compile :: String -> String -> [Option] -> [String] -> [String] -> IO () +compile basedir fullName options lvmPath doneModules = + do + let compileOptions = (options, fullName, doneModules) + putStrLn ("Compiling " ++ fullName) + + -- Store the current module file-name and its context in + -- two IO refs (unsafe! only used for internal error bug-report) + writeIORef refToCurrentFileName fullName + writeIORef refToCurrentImported doneModules + + contents <- safeReadFile fullName + + -- Phase 1: Lexing + (lexerWarnings, tokens) <- + doPhaseWithExit 20 (const "L") compileOptions $ + phaseLexer fullName contents options + + unless (NoWarnings `elem` options) $ + showMessages lexerWarnings + + -- Phase 2: Parsing + parsedModule <- + doPhaseWithExit 20 (const "P") compileOptions $ + phaseParser fullName tokens options + + -- Phase 3: Importing + (indirectionDecls, importEnvs) <- + phaseImport fullName parsedModule lvmPath options + + -- Phase 4: Resolving operators + resolvedModule <- + doPhaseWithExit 20 (const "R") compileOptions $ + phaseResolveOperators parsedModule importEnvs options + + stopCompilingIf (StopAfterParser `elem` options) + + -- Phase 5: Static checking + (localEnv, typeSignatures, staticWarnings) <- + doPhaseWithExit 20 (("S"++) . errorsLogCode) compileOptions $ + phaseStaticChecks fullName resolvedModule importEnvs options + + unless (NoWarnings `elem` options) $ + showMessages staticWarnings + + stopCompilingIf (StopAfterStaticAnalysis `elem` options) + + -- Phase 6: Kind inferencing (by default turned off) + let combinedEnv = foldr combineImportEnvironments localEnv importEnvs + when (KindInferencing `elem` options) $ + doPhaseWithExit maximumNumberOfKindErrors (const "K") compileOptions $ + phaseKindInferencer combinedEnv resolvedModule options + + -- Phase 7: Type Inference Directives + (beforeTypeInferEnv, typingStrategiesDecls) <- + phaseTypingStrategies fullName combinedEnv typeSignatures options + + -- Phase 8: Type inferencing + (dictionaryEnv, afterTypeInferEnv, toplevelTypes, typeWarnings) <- + doPhaseWithExit maximumNumberOfTypeErrors (const "T") compileOptions $ + phaseTypeInferencer basedir fullName resolvedModule {-doneModules-} localEnv beforeTypeInferEnv options + + unless (NoWarnings `elem` options) $ + showMessages typeWarnings + + stopCompilingIf (StopAfterTypeInferencing `elem` options) + + -- Phase 9: Desugaring + coreModule <- + phaseDesugarer dictionaryEnv + fullName resolvedModule + (typingStrategiesDecls ++ indirectionDecls) + afterTypeInferEnv + toplevelTypes + options + + stopCompilingIf (StopAfterDesugar `elem` options) + + -- Phase 10: Code generation + phaseCodeGenerator fullName coreModule options + + sendLog "C" fullName doneModules options + + let number = length staticWarnings + length typeWarnings + length lexerWarnings + putStrLn $ "Compilation successful" ++ + if number == 0 || (NoWarnings `elem` options) + then "" + else " with " ++ show number ++ " warning" ++ if number == 1 then "" else "s" + +safeReadFile :: String -> IO String +safeReadFile fullName = + CE.catch + (readFile fullName) + (\ioErr -> + let message = "Unable to read file " ++ show fullName + ++ " (" ++ show (ioErr :: CE.IOException) ++ ")" + in throw message) + +stopCompilingIf :: Bool -> IO () +stopCompilingIf bool = when bool (exitWith (ExitFailure 1)) + +maximumNumberOfTypeErrors :: Int +maximumNumberOfTypeErrors = 3 + +maximumNumberOfKindErrors :: Int +maximumNumberOfKindErrors = 1 diff --git a/src/Helium/Main/CompileUtils.hs b/src/Helium/Main/CompileUtils.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/CompileUtils.hs @@ -0,0 +1,121 @@ +{-| Module : CompileUtils + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.CompileUtils + ( module Helium.Main.CompileUtils + , Option(..) + , splitFilePath, combinePathAndFile + , when, unless + , exitWith, ExitCode(..), exitSuccess, getArgs + , module Helium.ModuleSystem.ImportEnvironment + , Module(..) + ) where + +import Helium.Main.Args(Option(..)) +import Helium.StaticAnalysis.Messages.Messages(HasMessage) +import Helium.StaticAnalysis.Messages.HeliumMessages(sortAndShowMessages) +import Control.Monad +import Helium.Utils.Utils(splitFilePath, combinePathAndFile) +import System.Exit +import System.Environment(getArgs) +import Helium.Utils.Logger +import Helium.ModuleSystem.ImportEnvironment +import Helium.Syntax.UHA_Syntax(Module(..)) +import Data.Maybe +import Lvm.Path(searchPathMaybe) +import System.FilePath (joinPath) +import System.Process(system) + +type Phase err a = IO (Either [err] a) +type CompileOptions = ([Option], String, [String]) + +(===>) :: Phase err1 a -> (a -> Phase err2 b) -> Phase (Either err1 err2) b +p ===> f = + p >>= either (return . Left . map Left) + (f >=> return . either (Left . map Right) Right) + +doPhaseWithExit :: HasMessage err => Int -> ([err] -> String) -> CompileOptions -> Phase err a -> IO a +doPhaseWithExit nrOfMsgs code (options, fullName, doneModules) phase = + do result <- phase + case result of + Left errs -> + do sendLog (code errs) fullName doneModules options + showErrorsAndExit errs nrOfMsgs + Right a -> + return a + +sendLog :: String -> String -> [String] -> [Option] -> IO () +sendLog code fullName modules = + logger code (Just (modules,fullName)) + +enterNewPhase :: String -> [Option] -> IO () +enterNewPhase phase options = + when (Verbose `elem` options) $ + putStrLn (phase ++ "...") + +showErrorsAndExit :: HasMessage a => [a] -> Int -> IO b +showErrorsAndExit errors maximumNumber = do + let someErrors = take maximumNumber errors + showMessages someErrors + when (number > maximumNumber) $ + putStrLn "(...)\n" + putStrLn ("Compilation failed with " ++ show number ++ + " error" ++ (if number == 1 then "" else "s")) + exitWith (ExitFailure 1) + where + number = length errors + +showMessages :: HasMessage a => [a] -> IO () +showMessages = + putStr . sortAndShowMessages + +makeCoreLib :: String -> String -> IO () +makeCoreLib basepath name = + do + let bps = [basepath] + maybeFullName <- searchPathMaybe bps ".lvm" name + case maybeFullName of + Just _ -> return () + Nothing -> do + maybeCoreName <- searchPathMaybe bps ".core" name + case maybeCoreName of + Just _ -> sys ("coreasm " ++ joinPath [basepath, name]) + Nothing -> do + putStr + ( "Cannot find " + ++ name ++ ".core in \n" + ++ basepath) + exitWith (ExitFailure 1) + +sys :: String -> IO () +sys s = do + -- putStrLn ("System:" ++ s) + _ <- system s + return () + +checkExistence :: [String] -> String -> IO () +checkExistence path name = + do + maybeLocation <- resolve path name + when (isNothing maybeLocation) $ do + putStr + ( "Cannot find " + ++ name + ++ ".hs (or .lvm) in search path:\n" + ++ unlines (map ("\t" ++) path) + ++ "Use the -P option to add paths to the search path.\n" + ) + exitWith (ExitFailure 1) + +resolve :: [String] -> String -> IO (Maybe String) +resolve path name = + do maybeFullName <- searchPathMaybe path ".hs" name + case maybeFullName of + Just fullName -> return (Just fullName) + Nothing -> searchPathMaybe path ".lvm" name + diff --git a/src/Helium/Main/PhaseCodeGenerator.hs b/src/Helium/Main/PhaseCodeGenerator.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/PhaseCodeGenerator.hs @@ -0,0 +1,28 @@ +{-| Module : PhaseCodeGenerator + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.PhaseCodeGenerator(phaseCodeGenerator) where + +import Lvm.Core.Expr(CoreModule) +import Helium.Main.CompileUtils +import Helium.CodeGeneration.CoreToLvm(coreToLvm) +import qualified Control.Exception as CE (catch, IOException) + +phaseCodeGenerator :: String -> CoreModule -> [Option] -> IO () +phaseCodeGenerator fullName coreModule options = do + enterNewPhase "Code generation" options + + let (path, baseName, _) = splitFilePath fullName + fullNameNoExt = combinePathAndFile path baseName + + CE.catch (coreToLvm fullNameNoExt coreModule) (\ioErr -> do + putStrLn ("Could not write to file '" ++ + fullNameNoExt ++ ".lvm" ++ "'" ++ show (ioErr :: CE.IOException)); + exitWith (ExitFailure 1) + ) + diff --git a/src/Helium/Main/PhaseDesugarer.hs b/src/Helium/Main/PhaseDesugarer.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/PhaseDesugarer.hs @@ -0,0 +1,67 @@ +{-| Module : PhaseDesugarer + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.PhaseDesugarer(phaseDesugarer) where + +import Helium.Main.CompileUtils +import Text.PrettyPrint.Leijen +import Lvm.Core.Expr(CoreModule, CoreDecl) +import Lvm.Core.RemoveDead( coreRemoveDead ) -- remove dead (import) declarations +import Helium.Syntax.UHA_Syntax(Name(..), MaybeName(..)) +import Helium.Syntax.UHA_Range(noRange) +import Helium.ModuleSystem.ImportEnvironment() +import Helium.ModuleSystem.DictionaryEnvironment (DictionaryEnvironment) +import qualified Helium.CodeGeneration.CodeGeneration as CodeGeneration + +phaseDesugarer :: DictionaryEnvironment -> + String -> Module -> [CoreDecl] -> + ImportEnvironment -> + TypeEnvironment -> [Option] -> IO CoreModule +phaseDesugarer dictionaryEnv fullName module_ extraDecls afterTypeInferEnv toplevelTypes options = do + enterNewPhase "Desugaring" options + + let (path, baseName, _) = splitFilePath fullName + fullNameNoExt = combinePathAndFile path baseName + +{- hier kunnen we misschien main inserten en dan is toplevelTypes niet nodig in AG. + +en eigenlijk is afterTypeInferEnv te groot. alleen locale types en constructoren hoeven gezien te worden + +-} + + moduleWithName = fixModuleName module_ baseName + + coreModule = CodeGeneration.core_Syn_Module $ + CodeGeneration.wrap_Module (CodeGeneration.sem_Module moduleWithName) + CodeGeneration.Inh_Module { + CodeGeneration.dictionaryEnv_Inh_Module = dictionaryEnv, + CodeGeneration.extraDecls_Inh_Module = extraDecls, + CodeGeneration.importEnv_Inh_Module = afterTypeInferEnv, + CodeGeneration.toplevelTypes_Inh_Module = toplevelTypes } + + strippedCoreModule = coreRemoveDead coreModule + + when (DumpCore `elem` options) $ + print . pretty $ strippedCoreModule + + when (DumpCoreToFile `elem` options) $ do + writeFile (fullNameNoExt ++ ".core") $ show . pretty $ strippedCoreModule + exitSuccess + + return strippedCoreModule + +-- | Make sure the module has a name. If there is no name (module without +-- header) insert the base name of the file name as name. +fixModuleName :: Module -> String -> Module +fixModuleName original@(Module_Module r name es b) baseName = + case name of + MaybeName_Nothing -> + Module_Module r (MaybeName_Just (Name_Identifier noRange [] baseName)) es b -- !!!Name + _ -> original + + diff --git a/src/Helium/Main/PhaseImport.hs b/src/Helium/Main/PhaseImport.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/PhaseImport.hs @@ -0,0 +1,92 @@ +{-| Module : PhaseImport + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.PhaseImport(phaseImport) where + +import Helium.Main.CompileUtils +import qualified Lvm.Core.Expr as Core +import qualified Lvm.Core.Utils as Core +import Lvm.Common.Id(Id, stringFromId) +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils +import Helium.Syntax.UHA_Range(noRange) +import Lvm.Path(searchPath) +import Lvm.Import(lvmImportDecls) +import Helium.ModuleSystem.CoreToImportEnv(getImportEnvironment) +import qualified Helium.ModuleSystem.ExtractImportDecls as EID +import Data.List(isPrefixOf) + +phaseImport :: String -> Module -> [String] -> [Option] -> + IO ([Core.CoreDecl], [ImportEnvironment]) +phaseImport fullName module_ lvmPath options = do + enterNewPhase "Importing" options + + let (_, baseName, _) = splitFilePath fullName + + -- Add HeliumLang and Prelude import + let moduleWithExtraImports = addImplicitImports module_ + + -- Chase imports + chasedImpsList <- chaseImports lvmPath moduleWithExtraImports + + let indirectionDecls = concat chasedImpsList + importEnvs = + map (getImportEnvironment baseName) chasedImpsList + + return (indirectionDecls, importEnvs) + +chaseImports :: [String] -> Module -> IO [[Core.CoreDecl]] +chaseImports lvmPath fromModule = + let coreImports = EID.coreImportDecls_Syn_Module $ EID.wrap_Module (EID.sem_Module fromModule) EID.Inh_Module -- Expand imports + findModule = searchPath lvmPath ".lvm" . stringFromId + doImport :: (Core.CoreDecl,[Id]) -> IO [Core.CoreDecl] + doImport (importDecl,hidings) + = do decls <- lvmImportDecls findModule [importDecl] + return [ d + | d <- concat decls + , let name = Core.declName d + , "show" `isPrefixOf` stringFromId name || name `notElem` hidings + ] + + in mapM doImport coreImports + -- zipWith ($) filterImports (lvmImportDecls findModule coreImportDecls) + +-- Add "import Prelude" if +-- the currently compiled module is not the Prelude and +-- the Prelude is not explicitly imported +-- Always add "import HeliumLang +addImplicitImports :: Module -> Module +addImplicitImports (Module_Module moduleRange maybeName exports + (Body_Body bodyRange explicitImportDecls decls)) = + Module_Module + moduleRange + maybeName + exports + (Body_Body + bodyRange + ( case maybeName of + MaybeName_Just n + | getNameName n == "Prelude" -> [] + _ -> if "Prelude" `elem` map stringFromImportDeclaration explicitImportDecls + then [] + else [ implicitImportDecl "Prelude" ] + ++ [ implicitImportDecl "HeliumLang" ] + ++ explicitImportDecls + ) decls + ) + where + -- Artificial import declaration for implicit Prelude import + implicitImportDecl :: String -> ImportDeclaration + implicitImportDecl moduleName = + ImportDeclaration_Import + noRange + False + (Name_Identifier noRange [] moduleName) -- !!!Name + MaybeName_Nothing + MaybeImportSpecification_Nothing +addImplicitImports (Module_Module _ _ _ (Body_Hole _ _)) = error "not supported" diff --git a/src/Helium/Main/PhaseKindInferencer.hs b/src/Helium/Main/PhaseKindInferencer.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/PhaseKindInferencer.hs @@ -0,0 +1,32 @@ +{-| Module : PhaseKindInferencer + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.PhaseKindInferencer (phaseKindInferencer) where + +import Helium.Main.CompileUtils +import Helium.StaticAnalysis.Inferencers.KindInferencing as KI +-- import ImportEnvironment +import qualified Data.Map as M +import Top.Types +import Helium.StaticAnalysis.Messages.KindErrors + +phaseKindInferencer :: ImportEnvironment -> Module -> [Option] -> Phase KindError () +phaseKindInferencer importEnvironment module_ options = + do enterNewPhase "Kind inferencing" options + let res = KI.wrap_Module (KI.sem_Module module_) KI.Inh_Module { + KI.importEnvironment_Inh_Module = importEnvironment, + KI.options_Inh_Module = options } + when (DumpTypeDebug `elem` options) $ + do KI.debugIO_Syn_Module res + putStrLn . unlines . map (\(n,ks) -> show n++" :: "++showKindScheme ks) . M.assocs $ KI.kindEnvironment_Syn_Module res + case KI.kindErrors_Syn_Module res of + + _:_ -> + return (Left $ KI.kindErrors_Syn_Module res) + [] -> + return (Right ()) diff --git a/src/Helium/Main/PhaseLexer.hs b/src/Helium/Main/PhaseLexer.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/PhaseLexer.hs @@ -0,0 +1,45 @@ +{-| Module : PhaseLexer + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.PhaseLexer(phaseLexer) where + +import Helium.Main.CompileUtils +import Helium.Parser.Lexer +import Helium.Parser.LayoutRule(layout) + +phaseLexer :: + String -> String -> [Option] -> + Phase LexerError ([LexerWarning], [Token]) + +phaseLexer fullName contents options = do + enterNewPhase "Lexing" options + + case lexer options fullName contents of + Left lexError -> + return (Left [lexError]) + Right (tokens, lexerWarnings) -> do + let tokensWithLayout = layout tokens + when (DumpTokens `elem` options) $ + print tokensWithLayout + let warnings = filterLooksLikeFloatWarnings lexerWarnings tokensWithLayout + return (Right (warnings, tokensWithLayout)) + +-- Throw away the looks like float warnings between the keywords "module" +-- and "where". +filterLooksLikeFloatWarnings :: [LexerWarning] -> [Token] -> [LexerWarning] +filterLooksLikeFloatWarnings warnings tokens = + case tokens of + (_, LexKeyword "module"):_ -> + case dropWhile test tokens of + (sp, _):_ -> filter (predicate sp) warnings + _ -> warnings + _ -> warnings + where + test (_, t) = t /= LexKeyword "where" + predicate sp1 (LexerWarning sp2 w) = + not (sp2 <= sp1 && isLooksLikeFloatWarningInfo w) diff --git a/src/Helium/Main/PhaseParser.hs b/src/Helium/Main/PhaseParser.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/PhaseParser.hs @@ -0,0 +1,26 @@ +{-| Module : PhaseParser + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.PhaseParser(phaseParser) where + +import Helium.Main.CompileUtils +import Helium.Parser.LexerToken(Token) +import Helium.Parser.Parser (module_) +import Helium.Parser.ParseLibrary(runHParser) +import Text.ParserCombinators.Parsec.Error (ParseError) + +phaseParser :: + String -> [Token] -> [Option] -> + Phase ParseError Module +phaseParser fullName tokens options = do + enterNewPhase "Parsing" options + case runHParser module_ fullName tokens True of + Left parseError -> + return (Left [parseError]) + Right m -> + return (Right m) diff --git a/src/Helium/Main/PhaseResolveOperators.hs b/src/Helium/Main/PhaseResolveOperators.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/PhaseResolveOperators.hs @@ -0,0 +1,41 @@ +{-| Module : PhaseResolveOperators + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.PhaseResolveOperators(phaseResolveOperators) where + +import Helium.Main.CompileUtils +import Helium.Parser.ResolveOperators(resolveOperators, operatorsFromModule, ResolveError) +import qualified Helium.Syntax.UHA_Pretty as PP(sem_Module,wrap_Module,Inh_Module(..),text_Syn_Module) +import qualified Data.Map as M + +phaseResolveOperators :: + Module -> [ImportEnvironment] -> [Option] -> + Phase ResolveError Module + +phaseResolveOperators moduleBeforeResolve importEnvs options = do + enterNewPhase "Resolving operators" options + + let importOperatorTable = + M.unions (operatorsFromModule moduleBeforeResolve : map operatorTable importEnvs) + + (module_, resolveErrors) = + resolveOperators importOperatorTable moduleBeforeResolve + + case resolveErrors of + + _:_ -> + return (Left resolveErrors) + + [] -> + do when (DumpUHA `elem` options) $ + print $ PP.text_Syn_Module $ PP.wrap_Module (PP.sem_Module module_) PP.Inh_Module + + return (Right module_) + + + diff --git a/src/Helium/Main/PhaseStaticChecks.hs b/src/Helium/Main/PhaseStaticChecks.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/PhaseStaticChecks.hs @@ -0,0 +1,45 @@ +{-| Module : PhaseStaticChecks + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.PhaseStaticChecks(phaseStaticChecks) where + +import Helium.Main.CompileUtils +import Helium.StaticAnalysis.Messages.Warnings(Warning) +import qualified Helium.StaticAnalysis.StaticChecks.StaticChecks as SC +import Helium.Syntax.UHA_Syntax (Name) +import Top.Types (TpScheme) +import Helium.StaticAnalysis.Messages.StaticErrors +import Helium.StaticAnalysis.Messages.Information (showInformation) + +phaseStaticChecks :: + String -> Module -> [ImportEnvironment] -> [Option] -> + Phase Error (ImportEnvironment, [(Name,TpScheme)], [Warning]) +phaseStaticChecks fullName module_ importEnvs options = do + enterNewPhase "Static checking" options + + let (_, baseName, _) = splitFilePath fullName + + res = SC.wrap_Module (SC.sem_Module module_) SC.Inh_Module { + SC.baseName_Inh_Module = baseName, + SC.importEnvironments_Inh_Module = importEnvs, + SC.options_Inh_Module = options } + + case SC.errors_Syn_Module res of + + _:_ -> + do when (DumpInformationForAllModules `elem` options) $ + print (foldr combineImportEnvironments emptyEnvironment importEnvs) + + -- display name information + let combinedEnv = foldr combineImportEnvironments emptyEnvironment importEnvs + showInformation False options combinedEnv + + return (Left $ SC.errors_Syn_Module res) + + [] -> + return (Right (SC.collectEnvironment_Syn_Module res, SC.typeSignatures_Syn_Module res, SC.warnings_Syn_Module res)) diff --git a/src/Helium/Main/PhaseTypeInferencer.hs b/src/Helium/Main/PhaseTypeInferencer.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/PhaseTypeInferencer.hs @@ -0,0 +1,66 @@ +{-| Module : PhaseTypeInferencer + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.PhaseTypeInferencer (phaseTypeInferencer) where + +import Helium.Main.CompileUtils +import Helium.StaticAnalysis.Messages.Warnings(Warning) +import Helium.StaticAnalysis.Inferencers.TypeInferencing(typeInferencing) +import Helium.ModuleSystem.DictionaryEnvironment (DictionaryEnvironment) +--import UHA_Syntax +import Helium.StaticAnalysis.Messages.TypeErrors +import Helium.StaticAnalysis.Messages.Information (showInformation) +import System.FilePath.Posix + +phaseTypeInferencer :: + String -> String -> Module -> ImportEnvironment -> ImportEnvironment -> [Option] -> + Phase TypeError (DictionaryEnvironment, ImportEnvironment, TypeEnvironment, [Warning]) + +phaseTypeInferencer basedir fullName module_ localEnv completeEnv options = do + enterNewPhase "Type inferencing" options + + -- 'W' and 'M' are predefined type inference algorithms + let newOptions = (if AlgorithmW `elem` options + then filter (/= NoSpreading) . ([TreeWalkInorderTopLastPost, SolverGreedy]++) + else id) + . (if AlgorithmM `elem` options + then filter (/= NoSpreading) . ([TreeWalkInorderTopFirstPre, SolverGreedy]++) + else id) + $ options + + (debugIO, dictionaryEnv, toplevelTypes, typeErrors, warnings) = + typeInferencing newOptions completeEnv module_ + + -- add the top-level types (including the inferred types) + finalEnv = addToTypeEnvironment toplevelTypes completeEnv + + when (DumpTypeDebug `elem` options) debugIO + + -- display name information + showInformation True options finalEnv + + case typeErrors of + + _:_ -> + do when (DumpInformationForAllModules `elem` options) $ + putStr (show completeEnv) + return (Left typeErrors) + + [] -> + do -- Dump information + when (DumpInformationForAllModules `elem` options) $ + print finalEnv + when (HFullQualification `elem` options) $ + writeFile (combinePathAndFile basedir (dropExtension $ takeFileName fullName) ++ ".fqn") + (holmesShowImpEnv module_ finalEnv) + when ( DumpInformationForThisModule `elem` options + && DumpInformationForAllModules `notElem` options + ) + $ print (addToTypeEnvironment toplevelTypes localEnv) + + return (Right (dictionaryEnv, finalEnv, toplevelTypes, warnings)) diff --git a/src/Helium/Main/PhaseTypingStrategies.hs b/src/Helium/Main/PhaseTypingStrategies.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/PhaseTypingStrategies.hs @@ -0,0 +1,35 @@ +{-| Module : PhaseTypingStrategies + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Main.PhaseTypingStrategies(phaseTypingStrategies) where + +import Helium.Main.CompileUtils +import Lvm.Core.Expr (CoreDecl) +import Helium.StaticAnalysis.Directives.TS_Compile (readTypingStrategiesFromFile) +import qualified Data.Map as M +import Helium.Syntax.UHA_Syntax (Name) +import Top.Types (TpScheme) + +phaseTypingStrategies :: String -> ImportEnvironment -> [(Name, TpScheme)] -> [Option] -> + IO (ImportEnvironment, [CoreDecl]) +phaseTypingStrategies fullName combinedEnv typeSignatures options + + | DisableDirectives `elem` options = + return (removeTypingStrategies combinedEnv, []) + + | otherwise = + let (path, baseName, _) = splitFilePath fullName + fullNameNoExt = combinePathAndFile path baseName + in do enterNewPhase "Type inference directives" options + (theTypingStrategies, typingStrategiesDecls) <- + readTypingStrategiesFromFile options (fullNameNoExt ++ ".type") + (addToTypeEnvironment (M.fromList typeSignatures) combinedEnv) + return + ( addTypingStrategies theTypingStrategies combinedEnv + , typingStrategiesDecls + ) diff --git a/src/Helium/Main/Version.hs b/src/Helium/Main/Version.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Main/Version.hs @@ -0,0 +1,4 @@ +module Helium.Main.Version where + +version :: String +version = "1.8 (Wed Jul 16 15:26:12 CEST 2014)" diff --git a/src/Helium/ModuleSystem/CoreToImportEnv.hs b/src/Helium/ModuleSystem/CoreToImportEnv.hs new file mode 100644 --- /dev/null +++ b/src/Helium/ModuleSystem/CoreToImportEnv.hs @@ -0,0 +1,205 @@ +{-| Module : CoreToImportEnv + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.ModuleSystem.CoreToImportEnv(getImportEnvironment) where + +import Lvm.Core.Expr +import Lvm.Core.Utils +import Helium.Utils.Utils +import Helium.StaticAnalysis.Miscellaneous.TypeConversion +import Helium.Parser.ParseLibrary +import Helium.Parser.Lexer(lexer) +import Helium.Parser.Parser(type_, contextAndType) +import Helium.ModuleSystem.ImportEnvironment +import Helium.Syntax.UHA_Utils +import Lvm.Common.Id +import Helium.Syntax.UHA_Syntax +import Helium.Parser.OperatorTable +import Top.Types +import Lvm.Common.Byte(stringFromBytes) +import Helium.Syntax.UHA_Range(makeImportRange, setNameRange) + +typeFromCustoms :: String -> [Custom] -> TpScheme +typeFromCustoms n [] = + internalError "CoreToImportEnv" "typeFromCustoms" + ("function import without type: " ++ n) +typeFromCustoms n ( CustomDecl (DeclKindCustom ident) [CustomBytes bytes] : cs) + | stringFromId ident == "type" = + let string = filter (/= '!') (stringFromBytes bytes) + in makeTpSchemeFromType (parseFromString contextAndType string) + | otherwise = + typeFromCustoms n cs +typeFromCustoms _ _ = error "Pattern match failure in ModuleSystem.CoreToImportEnv.typeFromCustoms" + +parseFromString :: HParser a -> String -> a +parseFromString p string = + case lexer [] "CoreToImportEnv" string of + Left _ -> internalError "CoreToImportEnv" "parseFromString" ("lex error in " ++ string) + Right (tokens, _) -> + case runHParser p "CoreToImportEnv" tokens True {- wait for EOF -} of + Left _ -> internalError "CoreToImportEnv" "parseFromString" ("parse error in " ++ string) + Right x -> x + +typeSynFromCustoms :: String -> [Custom] -> (Int, Tps -> Tp) -- !!! yuck +typeSynFromCustoms n (CustomBytes bs:cs) = + let + typeSynDecl = stringFromBytes bs + -- (too?) simple parser; works because type variables in synonym decls are renamed to 1 letter + ids = ( map (\x -> nameFromString [x]) + . filter (' '/=) + . takeWhile ('='/=) + . drop (length n + 1) + ) + typeSynDecl + rhsType = ( drop 1 + . dropWhile ('='/=) + ) + typeSynDecl + in + ( arityFromCustoms n cs + , \ts -> makeTpFromType (zip ids ts) (parseFromString type_ rhsType) + ) +typeSynFromCustoms n _ = + internalError "CoreToImportEnv" "typeSynFromCustoms" + ("type synonym import missing definition: " ++ n) + +-- in compiled Core files types have a kind (e.g. * -> *), +-- in Helium the have a number indicating the arity +arityFromCustoms :: String -> [Custom] -> Int +arityFromCustoms n [] = + internalError "CoreToImportEnv" "arityFromCustoms" + ("type constructor import without kind: " ++ n) +arityFromCustoms _ ( CustomInt arity : _ ) = arity +arityFromCustoms _ ( CustomDecl (DeclKindCustom ident) [CustomBytes bytes] : _ ) + | stringFromId ident == "kind" = + (length . filter ('*'==) . stringFromBytes) bytes - 1 + -- the number of stars minus 1 is the arity +arityFromCustoms n (_:cs) = arityFromCustoms n cs + +makeOperatorTable :: Name -> [Custom] -> [(Name, (Int, Assoc))] +makeOperatorTable oper (CustomInt i : CustomBytes bs : _) = + let + associativity = + case stringFromBytes bs of + "left" -> AssocLeft + "right" -> AssocRight + "none" -> AssocNone + assocStr -> intErr ("unknown associativity: " ++ assocStr) + + intErr = internalError "CoreToImportEnv" "makeOperatorTable" + in + if getNameName oper == "-" then + -- special rule: unary minus has the associativity + -- and the priority of the infix operator - + [ (oper, (i, associativity)) + , (intUnaryMinusName, (i, associativity)) + , (floatUnaryMinusName, (i, associativity)) + ] + else + [(oper, (i, associativity))] +makeOperatorTable oper _ = + internalError "CoreToImportEnv" "makeOperatorTable" + ("infix decl missing priority or associativity: " ++ show oper) + +makeImportName :: String -> Id -> Id -> Name +makeImportName importedInMod importedFromMod n = + setNameRange + (nameFromId n) + (makeImportRange (idFromString importedInMod) importedFromMod) + +getImportEnvironment :: String -> [CoreDecl] -> ImportEnvironment +getImportEnvironment importedInModule = foldr insert emptyEnvironment + where + insert decl = + case decl of + + -- functions + DeclAbstract { declName = n + , declAccess = Imported{importModule = importedFromModId} + , declCustoms = cs + } -> + addType + (makeImportName importedInModule importedFromModId n) + (typeFromCustoms (stringFromId n) cs) + + -- functions from non-core/non-lvm libraries and lvm-instructions + DeclExtern { declName = n + , declAccess = Imported{importModule = importedFromModId} + , declCustoms = cs + } -> + addType + (makeImportName importedInModule importedFromModId n) + (typeFromCustoms (stringFromId n) cs) + + -- constructors + DeclCon { declName = n + , declAccess = Imported{importModule = importedFromModId} + , declCustoms = cs + } -> + addValueConstructor + (makeImportName importedInModule importedFromModId n) + (typeFromCustoms (stringFromId n) cs) + + -- type constructor import + DeclCustom { declName = n + , declAccess = Imported{importModule = importedFromModId} + , declKind = DeclKindCustom ident + , declCustoms = cs + } + | stringFromId ident == "data" -> + addTypeConstructor + (makeImportName importedInModule importedFromModId n) + (arityFromCustoms (stringFromId n) cs) + + -- type synonym declarations + -- important: a type synonym also introduces a new type constructor! + DeclCustom { declName = n + , declAccess = Imported{importModule = importedFromModId} + , declKind = DeclKindCustom ident + , declCustoms = cs + } + | stringFromId ident == "typedecl" -> + let typename = makeImportName importedInModule importedFromModId n + pair = typeSynFromCustoms (stringFromId n) cs + in addTypeSynonym typename pair . addTypeConstructor typename (fst pair) + + -- infix decls + DeclCustom { declName = n + , declKind = DeclKindCustom ident + , declCustoms = cs + } + | stringFromId ident == "infix" -> + flip (foldr (uncurry addOperator)) (makeOperatorTable (nameFromId n) cs) + + -- typing strategies + DeclCustom { declName = _ + , declKind = DeclKindCustom ident + , declCustoms = cs + } + | stringFromId ident == "strategy" -> + let (CustomDecl _ [CustomBytes bytes]) = head cs + text = stringFromBytes bytes + in case reads text of + [(rule, [])] -> addTypingStrategies rule + _ -> intErr "Could not parse typing strategy from core file" + + -- !!! Print importedFromModId from "declAccess = Imported{importModule = importedFromModId}" as well + DeclAbstract{ declName = n } -> + intErr ("don't know how to handle declared DeclAbstract: " ++ stringFromId n) + DeclExtern { declName = n } -> + intErr ("don't know how to handle declared DeclExtern: " ++ stringFromId n) + DeclCon { declName = n } -> + intErr ("don't know how to handle declared DeclCon: " ++ stringFromId n) + DeclCustom { declName = n } -> + intErr ("don't know how to handle DeclCustom: " ++ stringFromId n) + DeclValue { declName = n } -> + intErr ("don't know how to handle DeclValue: " ++ stringFromId n) + DeclImport { declName = n } -> + intErr ("don't know how to handle DeclImport: " ++ stringFromId n) + + intErr = internalError "CoreToImportEnv" "getImportEnvironment" diff --git a/src/Helium/ModuleSystem/DictionaryEnvironment.hs b/src/Helium/ModuleSystem/DictionaryEnvironment.hs new file mode 100644 --- /dev/null +++ b/src/Helium/ModuleSystem/DictionaryEnvironment.hs @@ -0,0 +1,82 @@ +{-| Module : DictionaryEnvironment + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.ModuleSystem.DictionaryEnvironment + ( DictionaryEnvironment, DictionaryTree(..) + , emptyDictionaryEnvironment, addForDeclaration, addForVariable + , getPredicateForDecl, getDictionaryTrees + , makeDictionaryTree, makeDictionaryTrees + ) where + +import qualified Data.Map as M +import Helium.Syntax.UHA_Syntax (Name) +import Helium.Syntax.UHA_Utils (NameWithRange(..) ) +import Helium.Utils.Utils (internalError) +import Top.Types + +data DictionaryEnvironment = + DEnv { declMap :: M.Map NameWithRange Predicates + , varMap :: M.Map NameWithRange [DictionaryTree] + } + +data DictionaryTree = ByPredicate Predicate + | ByInstance String {- class name -} String {- instance name -} [DictionaryTree] + | BySuperClass String {- sub -} String {- super -} DictionaryTree + deriving Show + +instance Show DictionaryEnvironment where + show denv = + "{ declMap = " ++ show (M.assocs $ declMap denv) ++ + ", varMap = " ++ show (M.assocs $ varMap denv) ++ "}" + +emptyDictionaryEnvironment :: DictionaryEnvironment +emptyDictionaryEnvironment = + DEnv { declMap = M.empty, varMap = M.empty } + +addForDeclaration :: Name -> Predicates -> DictionaryEnvironment -> DictionaryEnvironment +addForDeclaration name predicates dEnv + | null predicates = dEnv + | otherwise = dEnv { declMap = M.insert (NameWithRange name) predicates (declMap dEnv) } + +addForVariable :: Name -> [DictionaryTree] -> DictionaryEnvironment -> DictionaryEnvironment +addForVariable name trees dEnv + | null trees = dEnv + | otherwise = dEnv { varMap = M.insert (NameWithRange name) trees (varMap dEnv) } + +getPredicateForDecl :: Name -> DictionaryEnvironment -> Predicates +getPredicateForDecl name dEnv = + M.findWithDefault [] (NameWithRange name) (declMap dEnv) + +getDictionaryTrees :: Name -> DictionaryEnvironment -> [DictionaryTree] +getDictionaryTrees name dEnv = + M.findWithDefault [] (NameWithRange name) (varMap dEnv) + +makeDictionaryTrees :: ClassEnvironment -> Predicates -> Predicates -> Maybe [DictionaryTree] +makeDictionaryTrees classEnv ps = mapM (makeDictionaryTree classEnv ps) + +makeDictionaryTree :: ClassEnvironment -> Predicates -> Predicate -> Maybe DictionaryTree +makeDictionaryTree classEnv availablePredicates p@(Predicate className tp) = + case tp of + TVar _ | p `elem` availablePredicates -> Just (ByPredicate p) + | otherwise -> case [ (path, availablePredicate) + | availablePredicate@(Predicate c t) <- availablePredicates + , t == tp + , path <- superclassPaths c className classEnv + ] of + [] -> Nothing + (path,fromPredicate):_ -> + let list = reverse (zip path (tail path)) + tree = foldr (uncurry BySuperClass) (ByPredicate fromPredicate) list + in Just tree + + _ -> case byInstance noOrderedTypeSynonyms classEnv p of + Nothing -> internalError "DictionaryEnvironment" "makeDictionaryTree" ("reduction error" ++ show (M.assocs classEnv)) + Just predicates -> + do let (TCon instanceName, _) = leftSpine tp + trees <- makeDictionaryTrees classEnv availablePredicates predicates + return (ByInstance className instanceName trees) diff --git a/src/Helium/ModuleSystem/ExtractImportDecls.ag b/src/Helium/ModuleSystem/ExtractImportDecls.ag new file mode 100644 --- /dev/null +++ b/src/Helium/ModuleSystem/ExtractImportDecls.ag @@ -0,0 +1,59 @@ +ATTR Module [ | | coreImportDecls : { [(Core.CoreDecl,[Id])] } ] + +INCLUDE "UHA_Syntax.ag" +INCLUDE "ToCoreName.ag" + +imports{ +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils +import Lvm.Common.Id +import qualified Lvm.Core.Expr as Core +import qualified Lvm.Core.Module as Core +import Helium.Utils.Utils (internalError) +} + + +ATTR Body ImportDeclarations ImportDeclaration + [ | | coreImportDecls USE { ++ } { [] } : { [(Core.CoreDecl,[Id])] } ] + +SEM ImportDeclaration + | Import + lhs.coreImportDecls = [(@loc.importDecls,@loc.hidings)] + loc.importDecls = + + if @qualified || not @asname.isNothing then + internalError "ExtractImportDecls.ag" "ImportDeclaration.Import" "qualified and as-imports not supported yet" + else + Core.DeclImport + { Core.declName = idFromName @name.self + , Core.declAccess = + Core.Imported + { Core.accessPublic = False -- private + , Core.importModule = idFromName @name.self + , Core.importName = dummyId + , Core.importKind = Core.DeclKindModule + , Core.importMajorVer = 0 + , Core.importMinorVer = 0 + } + , Core.declCustoms = [] + } + + loc.hidings = @importspecification.imps + +SEM MaybeImportSpecification [ | | imps : {[Id]}] + | Nothing lhs.imps = [] + | Just lhs.imps = @importspecification.imps + +SEM ImportSpecification + | Import lhs.imps = + if not @hiding then + internalError "ExtractImportDecls.ag" "ImportSpecification.Import" "import lists are not supported" + else + @imports.imps + +ATTR ImportSpecification Imports Import [ | | imps USE { ++ } { [] } : {[Id]} ] + +SEM Import + | Variable lhs.imps = [idFromName @name.self] + | TypeOrClass lhs.imps = internalError "ExtractImportDecls.ag" "ImportSpecification.Import" "only variables can be hidden" + | TypeOrClassComplete lhs.imps = internalError "ExtractImportDecls.ag" "ImportSpecification.Import" "only variables can be hidden" diff --git a/src/Helium/ModuleSystem/ExtractImportDecls.hs b/src/Helium/ModuleSystem/ExtractImportDecls.hs new file mode 100644 --- /dev/null +++ b/src/Helium/ModuleSystem/ExtractImportDecls.hs @@ -0,0 +1,5823 @@ +{-# LANGUAGE Rank2Types, GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Helium.ModuleSystem.ExtractImportDecls where + +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils +import Lvm.Common.Id +import qualified Lvm.Core.Expr as Core +import qualified Lvm.Core.Module as Core +import Helium.Utils.Utils (internalError) +import Control.Monad.Identity (Identity) +import qualified Control.Monad.Identity +-- Alternative ------------------------------------------------- +-- wrapper +data Inh_Alternative = Inh_Alternative { } +data Syn_Alternative = Syn_Alternative { self_Syn_Alternative :: (Alternative) } +{-# INLINABLE wrap_Alternative #-} +wrap_Alternative :: T_Alternative -> Inh_Alternative -> (Syn_Alternative ) +wrap_Alternative (T_Alternative act) (Inh_Alternative ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternative_vIn1 + (T_Alternative_vOut1 _lhsOself) <- return (inv_Alternative_s2 sem arg) + return (Syn_Alternative _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternative #-} +sem_Alternative :: Alternative -> T_Alternative +sem_Alternative ( Alternative_Hole range_ id_ ) = sem_Alternative_Hole ( sem_Range range_ ) id_ +sem_Alternative ( Alternative_Feedback range_ feedback_ alternative_ ) = sem_Alternative_Feedback ( sem_Range range_ ) feedback_ ( sem_Alternative alternative_ ) +sem_Alternative ( Alternative_Alternative range_ pattern_ righthandside_ ) = sem_Alternative_Alternative ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Alternative ( Alternative_Empty range_ ) = sem_Alternative_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Alternative = T_Alternative { + attach_T_Alternative :: Identity (T_Alternative_s2 ) + } +newtype T_Alternative_s2 = C_Alternative_s2 { + inv_Alternative_s2 :: (T_Alternative_v1 ) + } +data T_Alternative_s3 = C_Alternative_s3 +type T_Alternative_v1 = (T_Alternative_vIn1 ) -> (T_Alternative_vOut1 ) +data T_Alternative_vIn1 = T_Alternative_vIn1 +data T_Alternative_vOut1 = T_Alternative_vOut1 (Alternative) +{-# NOINLINE sem_Alternative_Hole #-} +sem_Alternative_Hole :: T_Range -> (Integer) -> T_Alternative +sem_Alternative_Hole arg_range_ arg_id_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule0 _rangeIself arg_id_ + _lhsOself :: Alternative + _lhsOself = rule1 _self + __result_ = T_Alternative_vOut1 _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule0 #-} + rule0 = \ ((_rangeIself) :: Range) id_ -> + Alternative_Hole _rangeIself id_ + {-# INLINE rule1 #-} + rule1 = \ _self -> + _self +{-# NOINLINE sem_Alternative_Feedback #-} +sem_Alternative_Feedback :: T_Range -> (String) -> T_Alternative -> T_Alternative +sem_Alternative_Feedback arg_range_ arg_feedback_ arg_alternative_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _alternativeX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_alternative_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Alternative_vOut1 _alternativeIself) = inv_Alternative_s2 _alternativeX2 (T_Alternative_vIn1 ) + _self = rule2 _alternativeIself _rangeIself arg_feedback_ + _lhsOself :: Alternative + _lhsOself = rule3 _self + __result_ = T_Alternative_vOut1 _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule2 #-} + rule2 = \ ((_alternativeIself) :: Alternative) ((_rangeIself) :: Range) feedback_ -> + Alternative_Feedback _rangeIself feedback_ _alternativeIself + {-# INLINE rule3 #-} + rule3 = \ _self -> + _self +{-# NOINLINE sem_Alternative_Alternative #-} +sem_Alternative_Alternative :: T_Range -> T_Pattern -> T_RightHandSide -> T_Alternative +sem_Alternative_Alternative arg_range_ arg_pattern_ arg_righthandside_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_RightHandSide_vOut148 _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 ) + _self = rule4 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Alternative + _lhsOself = rule5 _self + __result_ = T_Alternative_vOut1 _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule4 #-} + rule4 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Alternative_Alternative _rangeIself _patternIself _righthandsideIself + {-# INLINE rule5 #-} + rule5 = \ _self -> + _self +{-# NOINLINE sem_Alternative_Empty #-} +sem_Alternative_Empty :: T_Range -> T_Alternative +sem_Alternative_Empty arg_range_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule6 _rangeIself + _lhsOself :: Alternative + _lhsOself = rule7 _self + __result_ = T_Alternative_vOut1 _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule6 #-} + rule6 = \ ((_rangeIself) :: Range) -> + Alternative_Empty _rangeIself + {-# INLINE rule7 #-} + rule7 = \ _self -> + _self + +-- Alternatives ------------------------------------------------ +-- wrapper +data Inh_Alternatives = Inh_Alternatives { } +data Syn_Alternatives = Syn_Alternatives { self_Syn_Alternatives :: (Alternatives) } +{-# INLINABLE wrap_Alternatives #-} +wrap_Alternatives :: T_Alternatives -> Inh_Alternatives -> (Syn_Alternatives ) +wrap_Alternatives (T_Alternatives act) (Inh_Alternatives ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternatives_vIn4 + (T_Alternatives_vOut4 _lhsOself) <- return (inv_Alternatives_s5 sem arg) + return (Syn_Alternatives _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternatives #-} +sem_Alternatives :: Alternatives -> T_Alternatives +sem_Alternatives list = Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) + +-- semantic domain +newtype T_Alternatives = T_Alternatives { + attach_T_Alternatives :: Identity (T_Alternatives_s5 ) + } +newtype T_Alternatives_s5 = C_Alternatives_s5 { + inv_Alternatives_s5 :: (T_Alternatives_v4 ) + } +data T_Alternatives_s6 = C_Alternatives_s6 +type T_Alternatives_v4 = (T_Alternatives_vIn4 ) -> (T_Alternatives_vOut4 ) +data T_Alternatives_vIn4 = T_Alternatives_vIn4 +data T_Alternatives_vOut4 = T_Alternatives_vOut4 (Alternatives) +{-# NOINLINE sem_Alternatives_Cons #-} +sem_Alternatives_Cons :: T_Alternative -> T_Alternatives -> T_Alternatives +sem_Alternatives_Cons arg_hd_ arg_tl_ = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 ) -> ( let + _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_hd_)) + _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_tl_)) + (T_Alternative_vOut1 _hdIself) = inv_Alternative_s2 _hdX2 (T_Alternative_vIn1 ) + (T_Alternatives_vOut4 _tlIself) = inv_Alternatives_s5 _tlX5 (T_Alternatives_vIn4 ) + _self = rule8 _hdIself _tlIself + _lhsOself :: Alternatives + _lhsOself = rule9 _self + __result_ = T_Alternatives_vOut4 _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule8 #-} + rule8 = \ ((_hdIself) :: Alternative) ((_tlIself) :: Alternatives) -> + (:) _hdIself _tlIself + {-# INLINE rule9 #-} + rule9 = \ _self -> + _self +{-# NOINLINE sem_Alternatives_Nil #-} +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 ) -> ( let + _self = rule10 () + _lhsOself :: Alternatives + _lhsOself = rule11 _self + __result_ = T_Alternatives_vOut4 _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule10 #-} + rule10 = \ (_ :: ()) -> + [] + {-# INLINE rule11 #-} + rule11 = \ _self -> + _self + +-- AnnotatedType ----------------------------------------------- +-- wrapper +data Inh_AnnotatedType = Inh_AnnotatedType { } +data Syn_AnnotatedType = Syn_AnnotatedType { self_Syn_AnnotatedType :: (AnnotatedType) } +{-# INLINABLE wrap_AnnotatedType #-} +wrap_AnnotatedType :: T_AnnotatedType -> Inh_AnnotatedType -> (Syn_AnnotatedType ) +wrap_AnnotatedType (T_AnnotatedType act) (Inh_AnnotatedType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedType_vIn7 + (T_AnnotatedType_vOut7 _lhsOself) <- return (inv_AnnotatedType_s8 sem arg) + return (Syn_AnnotatedType _lhsOself) + ) + +-- cata +{-# INLINE sem_AnnotatedType #-} +sem_AnnotatedType :: AnnotatedType -> T_AnnotatedType +sem_AnnotatedType ( AnnotatedType_AnnotatedType range_ strict_ type_ ) = sem_AnnotatedType_AnnotatedType ( sem_Range range_ ) strict_ ( sem_Type type_ ) + +-- semantic domain +newtype T_AnnotatedType = T_AnnotatedType { + attach_T_AnnotatedType :: Identity (T_AnnotatedType_s8 ) + } +newtype T_AnnotatedType_s8 = C_AnnotatedType_s8 { + inv_AnnotatedType_s8 :: (T_AnnotatedType_v7 ) + } +data T_AnnotatedType_s9 = C_AnnotatedType_s9 +type T_AnnotatedType_v7 = (T_AnnotatedType_vIn7 ) -> (T_AnnotatedType_vOut7 ) +data T_AnnotatedType_vIn7 = T_AnnotatedType_vIn7 +data T_AnnotatedType_vOut7 = T_AnnotatedType_vOut7 (AnnotatedType) +{-# NOINLINE sem_AnnotatedType_AnnotatedType #-} +sem_AnnotatedType_AnnotatedType :: T_Range -> (Bool) -> T_Type -> T_AnnotatedType +sem_AnnotatedType_AnnotatedType arg_range_ arg_strict_ arg_type_ = T_AnnotatedType (return st8) where + {-# NOINLINE st8 #-} + st8 = let + v7 :: T_AnnotatedType_v7 + v7 = \ (T_AnnotatedType_vIn7 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule12 _rangeIself _typeIself arg_strict_ + _lhsOself :: AnnotatedType + _lhsOself = rule13 _self + __result_ = T_AnnotatedType_vOut7 _lhsOself + in __result_ ) + in C_AnnotatedType_s8 v7 + {-# INLINE rule12 #-} + rule12 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) strict_ -> + AnnotatedType_AnnotatedType _rangeIself strict_ _typeIself + {-# INLINE rule13 #-} + rule13 = \ _self -> + _self + +-- AnnotatedTypes ---------------------------------------------- +-- wrapper +data Inh_AnnotatedTypes = Inh_AnnotatedTypes { } +data Syn_AnnotatedTypes = Syn_AnnotatedTypes { self_Syn_AnnotatedTypes :: (AnnotatedTypes) } +{-# INLINABLE wrap_AnnotatedTypes #-} +wrap_AnnotatedTypes :: T_AnnotatedTypes -> Inh_AnnotatedTypes -> (Syn_AnnotatedTypes ) +wrap_AnnotatedTypes (T_AnnotatedTypes act) (Inh_AnnotatedTypes ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedTypes_vIn10 + (T_AnnotatedTypes_vOut10 _lhsOself) <- return (inv_AnnotatedTypes_s11 sem arg) + return (Syn_AnnotatedTypes _lhsOself) + ) + +-- cata +{-# NOINLINE sem_AnnotatedTypes #-} +sem_AnnotatedTypes :: AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes list = Prelude.foldr sem_AnnotatedTypes_Cons sem_AnnotatedTypes_Nil (Prelude.map sem_AnnotatedType list) + +-- semantic domain +newtype T_AnnotatedTypes = T_AnnotatedTypes { + attach_T_AnnotatedTypes :: Identity (T_AnnotatedTypes_s11 ) + } +newtype T_AnnotatedTypes_s11 = C_AnnotatedTypes_s11 { + inv_AnnotatedTypes_s11 :: (T_AnnotatedTypes_v10 ) + } +data T_AnnotatedTypes_s12 = C_AnnotatedTypes_s12 +type T_AnnotatedTypes_v10 = (T_AnnotatedTypes_vIn10 ) -> (T_AnnotatedTypes_vOut10 ) +data T_AnnotatedTypes_vIn10 = T_AnnotatedTypes_vIn10 +data T_AnnotatedTypes_vOut10 = T_AnnotatedTypes_vOut10 (AnnotatedTypes) +{-# NOINLINE sem_AnnotatedTypes_Cons #-} +sem_AnnotatedTypes_Cons :: T_AnnotatedType -> T_AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes_Cons arg_hd_ arg_tl_ = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _hdX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_hd_)) + _tlX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_tl_)) + (T_AnnotatedType_vOut7 _hdIself) = inv_AnnotatedType_s8 _hdX8 (T_AnnotatedType_vIn7 ) + (T_AnnotatedTypes_vOut10 _tlIself) = inv_AnnotatedTypes_s11 _tlX11 (T_AnnotatedTypes_vIn10 ) + _self = rule14 _hdIself _tlIself + _lhsOself :: AnnotatedTypes + _lhsOself = rule15 _self + __result_ = T_AnnotatedTypes_vOut10 _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule14 #-} + rule14 = \ ((_hdIself) :: AnnotatedType) ((_tlIself) :: AnnotatedTypes) -> + (:) _hdIself _tlIself + {-# INLINE rule15 #-} + rule15 = \ _self -> + _self +{-# NOINLINE sem_AnnotatedTypes_Nil #-} +sem_AnnotatedTypes_Nil :: T_AnnotatedTypes +sem_AnnotatedTypes_Nil = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _self = rule16 () + _lhsOself :: AnnotatedTypes + _lhsOself = rule17 _self + __result_ = T_AnnotatedTypes_vOut10 _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule16 #-} + rule16 = \ (_ :: ()) -> + [] + {-# INLINE rule17 #-} + rule17 = \ _self -> + _self + +-- Body -------------------------------------------------------- +-- wrapper +data Inh_Body = Inh_Body { } +data Syn_Body = Syn_Body { coreImportDecls_Syn_Body :: ( [(Core.CoreDecl,[Id])] ), self_Syn_Body :: (Body) } +{-# INLINABLE wrap_Body #-} +wrap_Body :: T_Body -> Inh_Body -> (Syn_Body ) +wrap_Body (T_Body act) (Inh_Body ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Body_vIn13 + (T_Body_vOut13 _lhsOcoreImportDecls _lhsOself) <- return (inv_Body_s14 sem arg) + return (Syn_Body _lhsOcoreImportDecls _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Body #-} +sem_Body :: Body -> T_Body +sem_Body ( Body_Hole range_ id_ ) = sem_Body_Hole ( sem_Range range_ ) id_ +sem_Body ( Body_Body range_ importdeclarations_ declarations_ ) = sem_Body_Body ( sem_Range range_ ) ( sem_ImportDeclarations importdeclarations_ ) ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_Body = T_Body { + attach_T_Body :: Identity (T_Body_s14 ) + } +newtype T_Body_s14 = C_Body_s14 { + inv_Body_s14 :: (T_Body_v13 ) + } +data T_Body_s15 = C_Body_s15 +type T_Body_v13 = (T_Body_vIn13 ) -> (T_Body_vOut13 ) +data T_Body_vIn13 = T_Body_vIn13 +data T_Body_vOut13 = T_Body_vOut13 ( [(Core.CoreDecl,[Id])] ) (Body) +{-# NOINLINE sem_Body_Hole #-} +sem_Body_Hole :: T_Range -> (Integer) -> T_Body +sem_Body_Hole arg_range_ arg_id_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcoreImportDecls :: [(Core.CoreDecl,[Id])] + _lhsOcoreImportDecls = rule18 () + _self = rule19 _rangeIself arg_id_ + _lhsOself :: Body + _lhsOself = rule20 _self + __result_ = T_Body_vOut13 _lhsOcoreImportDecls _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule18 #-} + rule18 = \ (_ :: ()) -> + [] + {-# INLINE rule19 #-} + rule19 = \ ((_rangeIself) :: Range) id_ -> + Body_Hole _rangeIself id_ + {-# INLINE rule20 #-} + rule20 = \ _self -> + _self +{-# NOINLINE sem_Body_Body #-} +sem_Body_Body :: T_Range -> T_ImportDeclarations -> T_Declarations -> T_Body +sem_Body_Body arg_range_ arg_importdeclarations_ arg_declarations_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importdeclarationsX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_importdeclarations_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ImportDeclarations_vOut73 _importdeclarationsIcoreImportDecls _importdeclarationsIself) = inv_ImportDeclarations_s74 _importdeclarationsX74 (T_ImportDeclarations_vIn73 ) + (T_Declarations_vOut31 _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _lhsOcoreImportDecls :: [(Core.CoreDecl,[Id])] + _lhsOcoreImportDecls = rule21 _importdeclarationsIcoreImportDecls + _self = rule22 _declarationsIself _importdeclarationsIself _rangeIself + _lhsOself :: Body + _lhsOself = rule23 _self + __result_ = T_Body_vOut13 _lhsOcoreImportDecls _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule21 #-} + rule21 = \ ((_importdeclarationsIcoreImportDecls) :: [(Core.CoreDecl,[Id])] ) -> + _importdeclarationsIcoreImportDecls + {-# INLINE rule22 #-} + rule22 = \ ((_declarationsIself) :: Declarations) ((_importdeclarationsIself) :: ImportDeclarations) ((_rangeIself) :: Range) -> + Body_Body _rangeIself _importdeclarationsIself _declarationsIself + {-# INLINE rule23 #-} + rule23 = \ _self -> + _self + +-- Constructor ------------------------------------------------- +-- wrapper +data Inh_Constructor = Inh_Constructor { } +data Syn_Constructor = Syn_Constructor { self_Syn_Constructor :: (Constructor) } +{-# INLINABLE wrap_Constructor #-} +wrap_Constructor :: T_Constructor -> Inh_Constructor -> (Syn_Constructor ) +wrap_Constructor (T_Constructor act) (Inh_Constructor ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructor_vIn16 + (T_Constructor_vOut16 _lhsOself) <- return (inv_Constructor_s17 sem arg) + return (Syn_Constructor _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructor #-} +sem_Constructor :: Constructor -> T_Constructor +sem_Constructor ( Constructor_Constructor range_ constructor_ types_ ) = sem_Constructor_Constructor ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_AnnotatedTypes types_ ) +sem_Constructor ( Constructor_Infix range_ leftType_ constructorOperator_ rightType_ ) = sem_Constructor_Infix ( sem_Range range_ ) ( sem_AnnotatedType leftType_ ) ( sem_Name constructorOperator_ ) ( sem_AnnotatedType rightType_ ) +sem_Constructor ( Constructor_Record range_ constructor_ fieldDeclarations_ ) = sem_Constructor_Record ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_FieldDeclarations fieldDeclarations_ ) + +-- semantic domain +newtype T_Constructor = T_Constructor { + attach_T_Constructor :: Identity (T_Constructor_s17 ) + } +newtype T_Constructor_s17 = C_Constructor_s17 { + inv_Constructor_s17 :: (T_Constructor_v16 ) + } +data T_Constructor_s18 = C_Constructor_s18 +type T_Constructor_v16 = (T_Constructor_vIn16 ) -> (T_Constructor_vOut16 ) +data T_Constructor_vIn16 = T_Constructor_vIn16 +data T_Constructor_vOut16 = T_Constructor_vOut16 (Constructor) +{-# NOINLINE sem_Constructor_Constructor #-} +sem_Constructor_Constructor :: T_Range -> T_Name -> T_AnnotatedTypes -> T_Constructor +sem_Constructor_Constructor arg_range_ arg_constructor_ arg_types_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _typesX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_AnnotatedTypes_vOut10 _typesIself) = inv_AnnotatedTypes_s11 _typesX11 (T_AnnotatedTypes_vIn10 ) + _self = rule24 _constructorIself _rangeIself _typesIself + _lhsOself :: Constructor + _lhsOself = rule25 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule24 #-} + rule24 = \ ((_constructorIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: AnnotatedTypes) -> + Constructor_Constructor _rangeIself _constructorIself _typesIself + {-# INLINE rule25 #-} + rule25 = \ _self -> + _self +{-# NOINLINE sem_Constructor_Infix #-} +sem_Constructor_Infix :: T_Range -> T_AnnotatedType -> T_Name -> T_AnnotatedType -> T_Constructor +sem_Constructor_Infix arg_range_ arg_leftType_ arg_constructorOperator_ arg_rightType_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_leftType_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_rightType_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_AnnotatedType_vOut7 _leftTypeIself) = inv_AnnotatedType_s8 _leftTypeX8 (T_AnnotatedType_vIn7 ) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_AnnotatedType_vOut7 _rightTypeIself) = inv_AnnotatedType_s8 _rightTypeX8 (T_AnnotatedType_vIn7 ) + _self = rule26 _constructorOperatorIself _leftTypeIself _rangeIself _rightTypeIself + _lhsOself :: Constructor + _lhsOself = rule27 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule26 #-} + rule26 = \ ((_constructorOperatorIself) :: Name) ((_leftTypeIself) :: AnnotatedType) ((_rangeIself) :: Range) ((_rightTypeIself) :: AnnotatedType) -> + Constructor_Infix _rangeIself _leftTypeIself _constructorOperatorIself _rightTypeIself + {-# INLINE rule27 #-} + rule27 = \ _self -> + _self +{-# NOINLINE sem_Constructor_Record #-} +sem_Constructor_Record :: T_Range -> T_Name -> T_FieldDeclarations -> T_Constructor +sem_Constructor_Record arg_range_ arg_constructor_ arg_fieldDeclarations_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _fieldDeclarationsX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_fieldDeclarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_FieldDeclarations_vOut49 _fieldDeclarationsIself) = inv_FieldDeclarations_s50 _fieldDeclarationsX50 (T_FieldDeclarations_vIn49 ) + _self = rule28 _constructorIself _fieldDeclarationsIself _rangeIself + _lhsOself :: Constructor + _lhsOself = rule29 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule28 #-} + rule28 = \ ((_constructorIself) :: Name) ((_fieldDeclarationsIself) :: FieldDeclarations) ((_rangeIself) :: Range) -> + Constructor_Record _rangeIself _constructorIself _fieldDeclarationsIself + {-# INLINE rule29 #-} + rule29 = \ _self -> + _self + +-- Constructors ------------------------------------------------ +-- wrapper +data Inh_Constructors = Inh_Constructors { } +data Syn_Constructors = Syn_Constructors { self_Syn_Constructors :: (Constructors) } +{-# INLINABLE wrap_Constructors #-} +wrap_Constructors :: T_Constructors -> Inh_Constructors -> (Syn_Constructors ) +wrap_Constructors (T_Constructors act) (Inh_Constructors ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructors_vIn19 + (T_Constructors_vOut19 _lhsOself) <- return (inv_Constructors_s20 sem arg) + return (Syn_Constructors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructors #-} +sem_Constructors :: Constructors -> T_Constructors +sem_Constructors list = Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list) + +-- semantic domain +newtype T_Constructors = T_Constructors { + attach_T_Constructors :: Identity (T_Constructors_s20 ) + } +newtype T_Constructors_s20 = C_Constructors_s20 { + inv_Constructors_s20 :: (T_Constructors_v19 ) + } +data T_Constructors_s21 = C_Constructors_s21 +type T_Constructors_v19 = (T_Constructors_vIn19 ) -> (T_Constructors_vOut19 ) +data T_Constructors_vIn19 = T_Constructors_vIn19 +data T_Constructors_vOut19 = T_Constructors_vOut19 (Constructors) +{-# NOINLINE sem_Constructors_Cons #-} +sem_Constructors_Cons :: T_Constructor -> T_Constructors -> T_Constructors +sem_Constructors_Cons arg_hd_ arg_tl_ = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 ) -> ( let + _hdX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_hd_)) + _tlX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_tl_)) + (T_Constructor_vOut16 _hdIself) = inv_Constructor_s17 _hdX17 (T_Constructor_vIn16 ) + (T_Constructors_vOut19 _tlIself) = inv_Constructors_s20 _tlX20 (T_Constructors_vIn19 ) + _self = rule30 _hdIself _tlIself + _lhsOself :: Constructors + _lhsOself = rule31 _self + __result_ = T_Constructors_vOut19 _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule30 #-} + rule30 = \ ((_hdIself) :: Constructor) ((_tlIself) :: Constructors) -> + (:) _hdIself _tlIself + {-# INLINE rule31 #-} + rule31 = \ _self -> + _self +{-# NOINLINE sem_Constructors_Nil #-} +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 ) -> ( let + _self = rule32 () + _lhsOself :: Constructors + _lhsOself = rule33 _self + __result_ = T_Constructors_vOut19 _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule32 #-} + rule32 = \ (_ :: ()) -> + [] + {-# INLINE rule33 #-} + rule33 = \ _self -> + _self + +-- ContextItem ------------------------------------------------- +-- wrapper +data Inh_ContextItem = Inh_ContextItem { } +data Syn_ContextItem = Syn_ContextItem { self_Syn_ContextItem :: (ContextItem) } +{-# INLINABLE wrap_ContextItem #-} +wrap_ContextItem :: T_ContextItem -> Inh_ContextItem -> (Syn_ContextItem ) +wrap_ContextItem (T_ContextItem act) (Inh_ContextItem ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItem_vIn22 + (T_ContextItem_vOut22 _lhsOself) <- return (inv_ContextItem_s23 sem arg) + return (Syn_ContextItem _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItem #-} +sem_ContextItem :: ContextItem -> T_ContextItem +sem_ContextItem ( ContextItem_ContextItem range_ name_ types_ ) = sem_ContextItem_ContextItem ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Types types_ ) + +-- semantic domain +newtype T_ContextItem = T_ContextItem { + attach_T_ContextItem :: Identity (T_ContextItem_s23 ) + } +newtype T_ContextItem_s23 = C_ContextItem_s23 { + inv_ContextItem_s23 :: (T_ContextItem_v22 ) + } +data T_ContextItem_s24 = C_ContextItem_s24 +type T_ContextItem_v22 = (T_ContextItem_vIn22 ) -> (T_ContextItem_vOut22 ) +data T_ContextItem_vIn22 = T_ContextItem_vIn22 +data T_ContextItem_vOut22 = T_ContextItem_vOut22 (ContextItem) +{-# NOINLINE sem_ContextItem_ContextItem #-} +sem_ContextItem_ContextItem :: T_Range -> T_Name -> T_Types -> T_ContextItem +sem_ContextItem_ContextItem arg_range_ arg_name_ arg_types_ = T_ContextItem (return st23) where + {-# NOINLINE st23 #-} + st23 = let + v22 :: T_ContextItem_v22 + v22 = \ (T_ContextItem_vIn22 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _self = rule34 _nameIself _rangeIself _typesIself + _lhsOself :: ContextItem + _lhsOself = rule35 _self + __result_ = T_ContextItem_vOut22 _lhsOself + in __result_ ) + in C_ContextItem_s23 v22 + {-# INLINE rule34 #-} + rule34 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + ContextItem_ContextItem _rangeIself _nameIself _typesIself + {-# INLINE rule35 #-} + rule35 = \ _self -> + _self + +-- ContextItems ------------------------------------------------ +-- wrapper +data Inh_ContextItems = Inh_ContextItems { } +data Syn_ContextItems = Syn_ContextItems { self_Syn_ContextItems :: (ContextItems) } +{-# INLINABLE wrap_ContextItems #-} +wrap_ContextItems :: T_ContextItems -> Inh_ContextItems -> (Syn_ContextItems ) +wrap_ContextItems (T_ContextItems act) (Inh_ContextItems ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItems_vIn25 + (T_ContextItems_vOut25 _lhsOself) <- return (inv_ContextItems_s26 sem arg) + return (Syn_ContextItems _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItems #-} +sem_ContextItems :: ContextItems -> T_ContextItems +sem_ContextItems list = Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list) + +-- semantic domain +newtype T_ContextItems = T_ContextItems { + attach_T_ContextItems :: Identity (T_ContextItems_s26 ) + } +newtype T_ContextItems_s26 = C_ContextItems_s26 { + inv_ContextItems_s26 :: (T_ContextItems_v25 ) + } +data T_ContextItems_s27 = C_ContextItems_s27 +type T_ContextItems_v25 = (T_ContextItems_vIn25 ) -> (T_ContextItems_vOut25 ) +data T_ContextItems_vIn25 = T_ContextItems_vIn25 +data T_ContextItems_vOut25 = T_ContextItems_vOut25 (ContextItems) +{-# NOINLINE sem_ContextItems_Cons #-} +sem_ContextItems_Cons :: T_ContextItem -> T_ContextItems -> T_ContextItems +sem_ContextItems_Cons arg_hd_ arg_tl_ = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _hdX23 = Control.Monad.Identity.runIdentity (attach_T_ContextItem (arg_hd_)) + _tlX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_tl_)) + (T_ContextItem_vOut22 _hdIself) = inv_ContextItem_s23 _hdX23 (T_ContextItem_vIn22 ) + (T_ContextItems_vOut25 _tlIself) = inv_ContextItems_s26 _tlX26 (T_ContextItems_vIn25 ) + _self = rule36 _hdIself _tlIself + _lhsOself :: ContextItems + _lhsOself = rule37 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule36 #-} + rule36 = \ ((_hdIself) :: ContextItem) ((_tlIself) :: ContextItems) -> + (:) _hdIself _tlIself + {-# INLINE rule37 #-} + rule37 = \ _self -> + _self +{-# NOINLINE sem_ContextItems_Nil #-} +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _self = rule38 () + _lhsOself :: ContextItems + _lhsOself = rule39 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule38 #-} + rule38 = \ (_ :: ()) -> + [] + {-# INLINE rule39 #-} + rule39 = \ _self -> + _self + +-- Declaration ------------------------------------------------- +-- wrapper +data Inh_Declaration = Inh_Declaration { } +data Syn_Declaration = Syn_Declaration { self_Syn_Declaration :: (Declaration) } +{-# INLINABLE wrap_Declaration #-} +wrap_Declaration :: T_Declaration -> Inh_Declaration -> (Syn_Declaration ) +wrap_Declaration (T_Declaration act) (Inh_Declaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declaration_vIn28 + (T_Declaration_vOut28 _lhsOself) <- return (inv_Declaration_s29 sem arg) + return (Syn_Declaration _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declaration #-} +sem_Declaration :: Declaration -> T_Declaration +sem_Declaration ( Declaration_Hole range_ id_ ) = sem_Declaration_Hole ( sem_Range range_ ) id_ +sem_Declaration ( Declaration_Type range_ simpletype_ type_ ) = sem_Declaration_Type ( sem_Range range_ ) ( sem_SimpleType simpletype_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Data range_ context_ simpletype_ constructors_ derivings_ ) = sem_Declaration_Data ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructors constructors_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Newtype range_ context_ simpletype_ constructor_ derivings_ ) = sem_Declaration_Newtype ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructor constructor_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Class range_ context_ simpletype_ where_ ) = sem_Declaration_Class ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Instance range_ context_ name_ types_ where_ ) = sem_Declaration_Instance ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Name name_ ) ( sem_Types types_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Default range_ types_ ) = sem_Declaration_Default ( sem_Range range_ ) ( sem_Types types_ ) +sem_Declaration ( Declaration_FunctionBindings range_ bindings_ ) = sem_Declaration_FunctionBindings ( sem_Range range_ ) ( sem_FunctionBindings bindings_ ) +sem_Declaration ( Declaration_PatternBinding range_ pattern_ righthandside_ ) = sem_Declaration_PatternBinding ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Declaration ( Declaration_TypeSignature range_ names_ type_ ) = sem_Declaration_TypeSignature ( sem_Range range_ ) ( sem_Names names_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Fixity range_ fixity_ priority_ operators_ ) = sem_Declaration_Fixity ( sem_Range range_ ) ( sem_Fixity fixity_ ) ( sem_MaybeInt priority_ ) ( sem_Names operators_ ) +sem_Declaration ( Declaration_Empty range_ ) = sem_Declaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Declaration = T_Declaration { + attach_T_Declaration :: Identity (T_Declaration_s29 ) + } +newtype T_Declaration_s29 = C_Declaration_s29 { + inv_Declaration_s29 :: (T_Declaration_v28 ) + } +data T_Declaration_s30 = C_Declaration_s30 +type T_Declaration_v28 = (T_Declaration_vIn28 ) -> (T_Declaration_vOut28 ) +data T_Declaration_vIn28 = T_Declaration_vIn28 +data T_Declaration_vOut28 = T_Declaration_vOut28 (Declaration) +{-# NOINLINE sem_Declaration_Hole #-} +sem_Declaration_Hole :: T_Range -> (Integer) -> T_Declaration +sem_Declaration_Hole arg_range_ arg_id_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule40 _rangeIself arg_id_ + _lhsOself :: Declaration + _lhsOself = rule41 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule40 #-} + rule40 = \ ((_rangeIself) :: Range) id_ -> + Declaration_Hole _rangeIself id_ + {-# INLINE rule41 #-} + rule41 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Type #-} +sem_Declaration_Type :: T_Range -> T_SimpleType -> T_Type -> T_Declaration +sem_Declaration_Type arg_range_ arg_simpletype_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule42 _rangeIself _simpletypeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule43 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule42 #-} + rule42 = \ ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_typeIself) :: Type) -> + Declaration_Type _rangeIself _simpletypeIself _typeIself + {-# INLINE rule43 #-} + rule43 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Data #-} +sem_Declaration_Data :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructors -> T_Names -> T_Declaration +sem_Declaration_Data arg_range_ arg_context_ arg_simpletype_ arg_constructors_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorsX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_constructors_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructors_vOut19 _constructorsIself) = inv_Constructors_s20 _constructorsX20 (T_Constructors_vIn19 ) + (T_Names_vOut115 _derivingsInames _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _self = rule44 _constructorsIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule45 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule44 #-} + rule44 = \ ((_constructorsIself) :: Constructors) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Data _rangeIself _contextIself _simpletypeIself _constructorsIself _derivingsIself + {-# INLINE rule45 #-} + rule45 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Newtype #-} +sem_Declaration_Newtype :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructor -> T_Names -> T_Declaration +sem_Declaration_Newtype arg_range_ arg_context_ arg_simpletype_ arg_constructor_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_constructor_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructor_vOut16 _constructorIself) = inv_Constructor_s17 _constructorX17 (T_Constructor_vIn16 ) + (T_Names_vOut115 _derivingsInames _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _self = rule46 _constructorIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule47 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule46 #-} + rule46 = \ ((_constructorIself) :: Constructor) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Newtype _rangeIself _contextIself _simpletypeIself _constructorIself _derivingsIself + {-# INLINE rule47 #-} + rule47 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Class #-} +sem_Declaration_Class :: T_Range -> T_ContextItems -> T_SimpleType -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Class arg_range_ arg_context_ arg_simpletype_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_MaybeDeclarations_vOut88 _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _self = rule48 _contextIself _rangeIself _simpletypeIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule49 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule48 #-} + rule48 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Class _rangeIself _contextIself _simpletypeIself _whereIself + {-# INLINE rule49 #-} + rule49 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Instance #-} +sem_Declaration_Instance :: T_Range -> T_ContextItems -> T_Name -> T_Types -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Instance arg_range_ arg_context_ arg_name_ arg_types_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + (T_MaybeDeclarations_vOut88 _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _self = rule50 _contextIself _nameIself _rangeIself _typesIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule51 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule50 #-} + rule50 = \ ((_contextIself) :: ContextItems) ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Instance _rangeIself _contextIself _nameIself _typesIself _whereIself + {-# INLINE rule51 #-} + rule51 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Default #-} +sem_Declaration_Default :: T_Range -> T_Types -> T_Declaration +sem_Declaration_Default arg_range_ arg_types_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _self = rule52 _rangeIself _typesIself + _lhsOself :: Declaration + _lhsOself = rule53 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule52 #-} + rule52 = \ ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + Declaration_Default _rangeIself _typesIself + {-# INLINE rule53 #-} + rule53 = \ _self -> + _self +{-# NOINLINE sem_Declaration_FunctionBindings #-} +sem_Declaration_FunctionBindings :: T_Range -> T_FunctionBindings -> T_Declaration +sem_Declaration_FunctionBindings arg_range_ arg_bindings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _bindingsX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_bindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBindings_vOut58 _bindingsIname _bindingsIself) = inv_FunctionBindings_s59 _bindingsX59 (T_FunctionBindings_vIn58 ) + _self = rule54 _bindingsIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule55 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule54 #-} + rule54 = \ ((_bindingsIself) :: FunctionBindings) ((_rangeIself) :: Range) -> + Declaration_FunctionBindings _rangeIself _bindingsIself + {-# INLINE rule55 #-} + rule55 = \ _self -> + _self +{-# NOINLINE sem_Declaration_PatternBinding #-} +sem_Declaration_PatternBinding :: T_Range -> T_Pattern -> T_RightHandSide -> T_Declaration +sem_Declaration_PatternBinding arg_range_ arg_pattern_ arg_righthandside_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_RightHandSide_vOut148 _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 ) + _self = rule56 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Declaration + _lhsOself = rule57 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule56 #-} + rule56 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Declaration_PatternBinding _rangeIself _patternIself _righthandsideIself + {-# INLINE rule57 #-} + rule57 = \ _self -> + _self +{-# NOINLINE sem_Declaration_TypeSignature #-} +sem_Declaration_TypeSignature :: T_Range -> T_Names -> T_Type -> T_Declaration +sem_Declaration_TypeSignature arg_range_ arg_names_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesInames _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule58 _namesIself _rangeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule59 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule58 #-} + rule58 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Declaration_TypeSignature _rangeIself _namesIself _typeIself + {-# INLINE rule59 #-} + rule59 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Fixity #-} +sem_Declaration_Fixity :: T_Range -> T_Fixity -> T_MaybeInt -> T_Names -> T_Declaration +sem_Declaration_Fixity arg_range_ arg_fixity_ arg_priority_ arg_operators_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fixityX53 = Control.Monad.Identity.runIdentity (attach_T_Fixity (arg_fixity_)) + _priorityX101 = Control.Monad.Identity.runIdentity (attach_T_MaybeInt (arg_priority_)) + _operatorsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_operators_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Fixity_vOut52 _fixityIself) = inv_Fixity_s53 _fixityX53 (T_Fixity_vIn52 ) + (T_MaybeInt_vOut100 _priorityIself) = inv_MaybeInt_s101 _priorityX101 (T_MaybeInt_vIn100 ) + (T_Names_vOut115 _operatorsInames _operatorsIself) = inv_Names_s116 _operatorsX116 (T_Names_vIn115 ) + _self = rule60 _fixityIself _operatorsIself _priorityIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule61 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule60 #-} + rule60 = \ ((_fixityIself) :: Fixity) ((_operatorsIself) :: Names) ((_priorityIself) :: MaybeInt) ((_rangeIself) :: Range) -> + Declaration_Fixity _rangeIself _fixityIself _priorityIself _operatorsIself + {-# INLINE rule61 #-} + rule61 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Empty #-} +sem_Declaration_Empty :: T_Range -> T_Declaration +sem_Declaration_Empty arg_range_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule62 _rangeIself + _lhsOself :: Declaration + _lhsOself = rule63 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule62 #-} + rule62 = \ ((_rangeIself) :: Range) -> + Declaration_Empty _rangeIself + {-# INLINE rule63 #-} + rule63 = \ _self -> + _self + +-- Declarations ------------------------------------------------ +-- wrapper +data Inh_Declarations = Inh_Declarations { } +data Syn_Declarations = Syn_Declarations { self_Syn_Declarations :: (Declarations) } +{-# INLINABLE wrap_Declarations #-} +wrap_Declarations :: T_Declarations -> Inh_Declarations -> (Syn_Declarations ) +wrap_Declarations (T_Declarations act) (Inh_Declarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declarations_vIn31 + (T_Declarations_vOut31 _lhsOself) <- return (inv_Declarations_s32 sem arg) + return (Syn_Declarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declarations #-} +sem_Declarations :: Declarations -> T_Declarations +sem_Declarations list = Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list) + +-- semantic domain +newtype T_Declarations = T_Declarations { + attach_T_Declarations :: Identity (T_Declarations_s32 ) + } +newtype T_Declarations_s32 = C_Declarations_s32 { + inv_Declarations_s32 :: (T_Declarations_v31 ) + } +data T_Declarations_s33 = C_Declarations_s33 +type T_Declarations_v31 = (T_Declarations_vIn31 ) -> (T_Declarations_vOut31 ) +data T_Declarations_vIn31 = T_Declarations_vIn31 +data T_Declarations_vOut31 = T_Declarations_vOut31 (Declarations) +{-# NOINLINE sem_Declarations_Cons #-} +sem_Declarations_Cons :: T_Declaration -> T_Declarations -> T_Declarations +sem_Declarations_Cons arg_hd_ arg_tl_ = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 ) -> ( let + _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Declaration (arg_hd_)) + _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_tl_)) + (T_Declaration_vOut28 _hdIself) = inv_Declaration_s29 _hdX29 (T_Declaration_vIn28 ) + (T_Declarations_vOut31 _tlIself) = inv_Declarations_s32 _tlX32 (T_Declarations_vIn31 ) + _self = rule64 _hdIself _tlIself + _lhsOself :: Declarations + _lhsOself = rule65 _self + __result_ = T_Declarations_vOut31 _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule64 #-} + rule64 = \ ((_hdIself) :: Declaration) ((_tlIself) :: Declarations) -> + (:) _hdIself _tlIself + {-# INLINE rule65 #-} + rule65 = \ _self -> + _self +{-# NOINLINE sem_Declarations_Nil #-} +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 ) -> ( let + _self = rule66 () + _lhsOself :: Declarations + _lhsOself = rule67 _self + __result_ = T_Declarations_vOut31 _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule66 #-} + rule66 = \ (_ :: ()) -> + [] + {-# INLINE rule67 #-} + rule67 = \ _self -> + _self + +-- Export ------------------------------------------------------ +-- wrapper +data Inh_Export = Inh_Export { } +data Syn_Export = Syn_Export { self_Syn_Export :: (Export) } +{-# INLINABLE wrap_Export #-} +wrap_Export :: T_Export -> Inh_Export -> (Syn_Export ) +wrap_Export (T_Export act) (Inh_Export ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Export_vIn34 + (T_Export_vOut34 _lhsOself) <- return (inv_Export_s35 sem arg) + return (Syn_Export _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Export #-} +sem_Export :: Export -> T_Export +sem_Export ( Export_Variable range_ name_ ) = sem_Export_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_TypeOrClass range_ name_ names_ ) = sem_Export_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Export ( Export_TypeOrClassComplete range_ name_ ) = sem_Export_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_Module range_ name_ ) = sem_Export_Module ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Export = T_Export { + attach_T_Export :: Identity (T_Export_s35 ) + } +newtype T_Export_s35 = C_Export_s35 { + inv_Export_s35 :: (T_Export_v34 ) + } +data T_Export_s36 = C_Export_s36 +type T_Export_v34 = (T_Export_vIn34 ) -> (T_Export_vOut34 ) +data T_Export_vIn34 = T_Export_vIn34 +data T_Export_vOut34 = T_Export_vOut34 (Export) +{-# NOINLINE sem_Export_Variable #-} +sem_Export_Variable :: T_Range -> T_Name -> T_Export +sem_Export_Variable arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule68 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule69 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule68 #-} + rule68 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Variable _rangeIself _nameIself + {-# INLINE rule69 #-} + rule69 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClass #-} +sem_Export_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Export +sem_Export_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesInames _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _self = rule70 _nameIself _namesIself _rangeIself + _lhsOself :: Export + _lhsOself = rule71 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule70 #-} + rule70 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Export_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule71 #-} + rule71 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClassComplete #-} +sem_Export_TypeOrClassComplete :: T_Range -> T_Name -> T_Export +sem_Export_TypeOrClassComplete arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule72 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule73 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule72 #-} + rule72 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule73 #-} + rule73 = \ _self -> + _self +{-# NOINLINE sem_Export_Module #-} +sem_Export_Module :: T_Range -> T_Name -> T_Export +sem_Export_Module arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule74 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule75 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule74 #-} + rule74 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Module _rangeIself _nameIself + {-# INLINE rule75 #-} + rule75 = \ _self -> + _self + +-- Exports ----------------------------------------------------- +-- wrapper +data Inh_Exports = Inh_Exports { } +data Syn_Exports = Syn_Exports { self_Syn_Exports :: (Exports) } +{-# INLINABLE wrap_Exports #-} +wrap_Exports :: T_Exports -> Inh_Exports -> (Syn_Exports ) +wrap_Exports (T_Exports act) (Inh_Exports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Exports_vIn37 + (T_Exports_vOut37 _lhsOself) <- return (inv_Exports_s38 sem arg) + return (Syn_Exports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Exports #-} +sem_Exports :: Exports -> T_Exports +sem_Exports list = Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list) + +-- semantic domain +newtype T_Exports = T_Exports { + attach_T_Exports :: Identity (T_Exports_s38 ) + } +newtype T_Exports_s38 = C_Exports_s38 { + inv_Exports_s38 :: (T_Exports_v37 ) + } +data T_Exports_s39 = C_Exports_s39 +type T_Exports_v37 = (T_Exports_vIn37 ) -> (T_Exports_vOut37 ) +data T_Exports_vIn37 = T_Exports_vIn37 +data T_Exports_vOut37 = T_Exports_vOut37 (Exports) +{-# NOINLINE sem_Exports_Cons #-} +sem_Exports_Cons :: T_Export -> T_Exports -> T_Exports +sem_Exports_Cons arg_hd_ arg_tl_ = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Export (arg_hd_)) + _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_tl_)) + (T_Export_vOut34 _hdIself) = inv_Export_s35 _hdX35 (T_Export_vIn34 ) + (T_Exports_vOut37 _tlIself) = inv_Exports_s38 _tlX38 (T_Exports_vIn37 ) + _self = rule76 _hdIself _tlIself + _lhsOself :: Exports + _lhsOself = rule77 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule76 #-} + rule76 = \ ((_hdIself) :: Export) ((_tlIself) :: Exports) -> + (:) _hdIself _tlIself + {-# INLINE rule77 #-} + rule77 = \ _self -> + _self +{-# NOINLINE sem_Exports_Nil #-} +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _self = rule78 () + _lhsOself :: Exports + _lhsOself = rule79 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule78 #-} + rule78 = \ (_ :: ()) -> + [] + {-# INLINE rule79 #-} + rule79 = \ _self -> + _self + +-- Expression -------------------------------------------------- +-- wrapper +data Inh_Expression = Inh_Expression { } +data Syn_Expression = Syn_Expression { self_Syn_Expression :: (Expression) } +{-# INLINABLE wrap_Expression #-} +wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) +wrap_Expression (T_Expression act) (Inh_Expression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expression_vIn40 + (T_Expression_vOut40 _lhsOself) <- return (inv_Expression_s41 sem arg) + return (Syn_Expression _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expression #-} +sem_Expression :: Expression -> T_Expression +sem_Expression ( Expression_Hole range_ id_ ) = sem_Expression_Hole ( sem_Range range_ ) id_ +sem_Expression ( Expression_Feedback range_ feedback_ expression_ ) = sem_Expression_Feedback ( sem_Range range_ ) feedback_ ( sem_Expression expression_ ) +sem_Expression ( Expression_MustUse range_ expression_ ) = sem_Expression_MustUse ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Literal range_ literal_ ) = sem_Expression_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Expression ( Expression_Variable range_ name_ ) = sem_Expression_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Constructor range_ name_ ) = sem_Expression_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Parenthesized range_ expression_ ) = sem_Expression_Parenthesized ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NormalApplication range_ function_ arguments_ ) = sem_Expression_NormalApplication ( sem_Range range_ ) ( sem_Expression function_ ) ( sem_Expressions arguments_ ) +sem_Expression ( Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ ) = sem_Expression_InfixApplication ( sem_Range range_ ) ( sem_MaybeExpression leftExpression_ ) ( sem_Expression operator_ ) ( sem_MaybeExpression rightExpression_ ) +sem_Expression ( Expression_If range_ guardExpression_ thenExpression_ elseExpression_ ) = sem_Expression_If ( sem_Range range_ ) ( sem_Expression guardExpression_ ) ( sem_Expression thenExpression_ ) ( sem_Expression elseExpression_ ) +sem_Expression ( Expression_Lambda range_ patterns_ expression_ ) = sem_Expression_Lambda ( sem_Range range_ ) ( sem_Patterns patterns_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Case range_ expression_ alternatives_ ) = sem_Expression_Case ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Alternatives alternatives_ ) +sem_Expression ( Expression_Let range_ declarations_ expression_ ) = sem_Expression_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Do range_ statements_ ) = sem_Expression_Do ( sem_Range range_ ) ( sem_Statements statements_ ) +sem_Expression ( Expression_List range_ expressions_ ) = sem_Expression_List ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Tuple range_ expressions_ ) = sem_Expression_Tuple ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Comprehension range_ expression_ qualifiers_ ) = sem_Expression_Comprehension ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Qualifiers qualifiers_ ) +sem_Expression ( Expression_Typed range_ expression_ type_ ) = sem_Expression_Typed ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Type type_ ) +sem_Expression ( Expression_RecordConstruction range_ name_ recordExpressionBindings_ ) = sem_Expression_RecordConstruction ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_RecordUpdate range_ expression_ recordExpressionBindings_ ) = sem_Expression_RecordUpdate ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_Enum range_ from_ then_ to_ ) = sem_Expression_Enum ( sem_Range range_ ) ( sem_Expression from_ ) ( sem_MaybeExpression then_ ) ( sem_MaybeExpression to_ ) +sem_Expression ( Expression_Negate range_ expression_ ) = sem_Expression_Negate ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NegateFloat range_ expression_ ) = sem_Expression_NegateFloat ( sem_Range range_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_Expression = T_Expression { + attach_T_Expression :: Identity (T_Expression_s41 ) + } +newtype T_Expression_s41 = C_Expression_s41 { + inv_Expression_s41 :: (T_Expression_v40 ) + } +data T_Expression_s42 = C_Expression_s42 +type T_Expression_v40 = (T_Expression_vIn40 ) -> (T_Expression_vOut40 ) +data T_Expression_vIn40 = T_Expression_vIn40 +data T_Expression_vOut40 = T_Expression_vOut40 (Expression) +{-# NOINLINE sem_Expression_Hole #-} +sem_Expression_Hole :: T_Range -> (Integer) -> T_Expression +sem_Expression_Hole arg_range_ arg_id_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule80 _rangeIself arg_id_ + _lhsOself :: Expression + _lhsOself = rule81 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule80 #-} + rule80 = \ ((_rangeIself) :: Range) id_ -> + Expression_Hole _rangeIself id_ + {-# INLINE rule81 #-} + rule81 = \ _self -> + _self +{-# NOINLINE sem_Expression_Feedback #-} +sem_Expression_Feedback :: T_Range -> (String) -> T_Expression -> T_Expression +sem_Expression_Feedback arg_range_ arg_feedback_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule82 _expressionIself _rangeIself arg_feedback_ + _lhsOself :: Expression + _lhsOself = rule83 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule82 #-} + rule82 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) feedback_ -> + Expression_Feedback _rangeIself feedback_ _expressionIself + {-# INLINE rule83 #-} + rule83 = \ _self -> + _self +{-# NOINLINE sem_Expression_MustUse #-} +sem_Expression_MustUse :: T_Range -> T_Expression -> T_Expression +sem_Expression_MustUse arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule84 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule85 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule84 #-} + rule84 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_MustUse _rangeIself _expressionIself + {-# INLINE rule85 #-} + rule85 = \ _self -> + _self +{-# NOINLINE sem_Expression_Literal #-} +sem_Expression_Literal :: T_Range -> T_Literal -> T_Expression +sem_Expression_Literal arg_range_ arg_literal_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule86 _literalIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule87 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule86 #-} + rule86 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Expression_Literal _rangeIself _literalIself + {-# INLINE rule87 #-} + rule87 = \ _self -> + _self +{-# NOINLINE sem_Expression_Variable #-} +sem_Expression_Variable :: T_Range -> T_Name -> T_Expression +sem_Expression_Variable arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule88 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule89 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule88 #-} + rule88 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Variable _rangeIself _nameIself + {-# INLINE rule89 #-} + rule89 = \ _self -> + _self +{-# NOINLINE sem_Expression_Constructor #-} +sem_Expression_Constructor :: T_Range -> T_Name -> T_Expression +sem_Expression_Constructor arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule90 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule91 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule90 #-} + rule90 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Constructor _rangeIself _nameIself + {-# INLINE rule91 #-} + rule91 = \ _self -> + _self +{-# NOINLINE sem_Expression_Parenthesized #-} +sem_Expression_Parenthesized :: T_Range -> T_Expression -> T_Expression +sem_Expression_Parenthesized arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule92 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule93 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule92 #-} + rule92 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Parenthesized _rangeIself _expressionIself + {-# INLINE rule93 #-} + rule93 = \ _self -> + _self +{-# NOINLINE sem_Expression_NormalApplication #-} +sem_Expression_NormalApplication :: T_Range -> T_Expression -> T_Expressions -> T_Expression +sem_Expression_NormalApplication arg_range_ arg_function_ arg_arguments_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_function_)) + _argumentsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _functionIself) = inv_Expression_s41 _functionX41 (T_Expression_vIn40 ) + (T_Expressions_vOut43 _argumentsIself) = inv_Expressions_s44 _argumentsX44 (T_Expressions_vIn43 ) + _self = rule94 _argumentsIself _functionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule95 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule94 #-} + rule94 = \ ((_argumentsIself) :: Expressions) ((_functionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NormalApplication _rangeIself _functionIself _argumentsIself + {-# INLINE rule95 #-} + rule95 = \ _self -> + _self +{-# NOINLINE sem_Expression_InfixApplication #-} +sem_Expression_InfixApplication :: T_Range -> T_MaybeExpression -> T_Expression -> T_MaybeExpression -> T_Expression +sem_Expression_InfixApplication arg_range_ arg_leftExpression_ arg_operator_ arg_rightExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_leftExpression_)) + _operatorX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_operator_)) + _rightExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_rightExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeExpression_vOut94 _leftExpressionIself) = inv_MaybeExpression_s95 _leftExpressionX95 (T_MaybeExpression_vIn94 ) + (T_Expression_vOut40 _operatorIself) = inv_Expression_s41 _operatorX41 (T_Expression_vIn40 ) + (T_MaybeExpression_vOut94 _rightExpressionIself) = inv_MaybeExpression_s95 _rightExpressionX95 (T_MaybeExpression_vIn94 ) + _self = rule96 _leftExpressionIself _operatorIself _rangeIself _rightExpressionIself + _lhsOself :: Expression + _lhsOself = rule97 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule96 #-} + rule96 = \ ((_leftExpressionIself) :: MaybeExpression) ((_operatorIself) :: Expression) ((_rangeIself) :: Range) ((_rightExpressionIself) :: MaybeExpression) -> + Expression_InfixApplication _rangeIself _leftExpressionIself _operatorIself _rightExpressionIself + {-# INLINE rule97 #-} + rule97 = \ _self -> + _self +{-# NOINLINE sem_Expression_If #-} +sem_Expression_If :: T_Range -> T_Expression -> T_Expression -> T_Expression -> T_Expression +sem_Expression_If arg_range_ arg_guardExpression_ arg_thenExpression_ arg_elseExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guardExpression_)) + _thenExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_thenExpression_)) + _elseExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_elseExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardExpressionIself) = inv_Expression_s41 _guardExpressionX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _thenExpressionIself) = inv_Expression_s41 _thenExpressionX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _elseExpressionIself) = inv_Expression_s41 _elseExpressionX41 (T_Expression_vIn40 ) + _self = rule98 _elseExpressionIself _guardExpressionIself _rangeIself _thenExpressionIself + _lhsOself :: Expression + _lhsOself = rule99 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule98 #-} + rule98 = \ ((_elseExpressionIself) :: Expression) ((_guardExpressionIself) :: Expression) ((_rangeIself) :: Range) ((_thenExpressionIself) :: Expression) -> + Expression_If _rangeIself _guardExpressionIself _thenExpressionIself _elseExpressionIself + {-# INLINE rule99 #-} + rule99 = \ _self -> + _self +{-# NOINLINE sem_Expression_Lambda #-} +sem_Expression_Lambda :: T_Range -> T_Patterns -> T_Expression -> T_Expression +sem_Expression_Lambda arg_range_ arg_patterns_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule100 _expressionIself _patternsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule101 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule100 #-} + rule100 = \ ((_expressionIself) :: Expression) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Expression_Lambda _rangeIself _patternsIself _expressionIself + {-# INLINE rule101 #-} + rule101 = \ _self -> + _self +{-# NOINLINE sem_Expression_Case #-} +sem_Expression_Case :: T_Range -> T_Expression -> T_Alternatives -> T_Expression +sem_Expression_Case arg_range_ arg_expression_ arg_alternatives_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _alternativesX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_alternatives_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Alternatives_vOut4 _alternativesIself) = inv_Alternatives_s5 _alternativesX5 (T_Alternatives_vIn4 ) + _self = rule102 _alternativesIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule103 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule102 #-} + rule102 = \ ((_alternativesIself) :: Alternatives) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Case _rangeIself _expressionIself _alternativesIself + {-# INLINE rule103 #-} + rule103 = \ _self -> + _self +{-# NOINLINE sem_Expression_Let #-} +sem_Expression_Let :: T_Range -> T_Declarations -> T_Expression -> T_Expression +sem_Expression_Let arg_range_ arg_declarations_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule104 _declarationsIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule105 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule104 #-} + rule104 = \ ((_declarationsIself) :: Declarations) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Let _rangeIself _declarationsIself _expressionIself + {-# INLINE rule105 #-} + rule105 = \ _self -> + _self +{-# NOINLINE sem_Expression_Do #-} +sem_Expression_Do :: T_Range -> T_Statements -> T_Expression +sem_Expression_Do arg_range_ arg_statements_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _statementsX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_statements_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Statements_vOut157 _statementsIself) = inv_Statements_s158 _statementsX158 (T_Statements_vIn157 ) + _self = rule106 _rangeIself _statementsIself + _lhsOself :: Expression + _lhsOself = rule107 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule106 #-} + rule106 = \ ((_rangeIself) :: Range) ((_statementsIself) :: Statements) -> + Expression_Do _rangeIself _statementsIself + {-# INLINE rule107 #-} + rule107 = \ _self -> + _self +{-# NOINLINE sem_Expression_List #-} +sem_Expression_List :: T_Range -> T_Expressions -> T_Expression +sem_Expression_List arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 ) + _self = rule108 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule109 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule108 #-} + rule108 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_List _rangeIself _expressionsIself + {-# INLINE rule109 #-} + rule109 = \ _self -> + _self +{-# NOINLINE sem_Expression_Tuple #-} +sem_Expression_Tuple :: T_Range -> T_Expressions -> T_Expression +sem_Expression_Tuple arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 ) + _self = rule110 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule111 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule110 #-} + rule110 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_Tuple _rangeIself _expressionsIself + {-# INLINE rule111 #-} + rule111 = \ _self -> + _self +{-# NOINLINE sem_Expression_Comprehension #-} +sem_Expression_Comprehension :: T_Range -> T_Expression -> T_Qualifiers -> T_Expression +sem_Expression_Comprehension arg_range_ arg_expression_ arg_qualifiers_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _qualifiersX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_qualifiers_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Qualifiers_vOut130 _qualifiersIself) = inv_Qualifiers_s131 _qualifiersX131 (T_Qualifiers_vIn130 ) + _self = rule112 _expressionIself _qualifiersIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule113 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule112 #-} + rule112 = \ ((_expressionIself) :: Expression) ((_qualifiersIself) :: Qualifiers) ((_rangeIself) :: Range) -> + Expression_Comprehension _rangeIself _expressionIself _qualifiersIself + {-# INLINE rule113 #-} + rule113 = \ _self -> + _self +{-# NOINLINE sem_Expression_Typed #-} +sem_Expression_Typed :: T_Range -> T_Expression -> T_Type -> T_Expression +sem_Expression_Typed arg_range_ arg_expression_ arg_type_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule114 _expressionIself _rangeIself _typeIself + _lhsOself :: Expression + _lhsOself = rule115 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule114 #-} + rule114 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Expression_Typed _rangeIself _expressionIself _typeIself + {-# INLINE rule115 #-} + rule115 = \ _self -> + _self +{-# NOINLINE sem_Expression_RecordConstruction #-} +sem_Expression_RecordConstruction :: T_Range -> T_Name -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordConstruction arg_range_ arg_name_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 ) + _self = rule116 _nameIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule117 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule116 #-} + rule116 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordConstruction _rangeIself _nameIself _recordExpressionBindingsIself + {-# INLINE rule117 #-} + rule117 = \ _self -> + _self +{-# NOINLINE sem_Expression_RecordUpdate #-} +sem_Expression_RecordUpdate :: T_Range -> T_Expression -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordUpdate arg_range_ arg_expression_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 ) + _self = rule118 _expressionIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule119 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule118 #-} + rule118 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordUpdate _rangeIself _expressionIself _recordExpressionBindingsIself + {-# INLINE rule119 #-} + rule119 = \ _self -> + _self +{-# NOINLINE sem_Expression_Enum #-} +sem_Expression_Enum :: T_Range -> T_Expression -> T_MaybeExpression -> T_MaybeExpression -> T_Expression +sem_Expression_Enum arg_range_ arg_from_ arg_then_ arg_to_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fromX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_from_)) + _thenX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_then_)) + _toX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_to_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _fromIself) = inv_Expression_s41 _fromX41 (T_Expression_vIn40 ) + (T_MaybeExpression_vOut94 _thenIself) = inv_MaybeExpression_s95 _thenX95 (T_MaybeExpression_vIn94 ) + (T_MaybeExpression_vOut94 _toIself) = inv_MaybeExpression_s95 _toX95 (T_MaybeExpression_vIn94 ) + _self = rule120 _fromIself _rangeIself _thenIself _toIself + _lhsOself :: Expression + _lhsOself = rule121 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule120 #-} + rule120 = \ ((_fromIself) :: Expression) ((_rangeIself) :: Range) ((_thenIself) :: MaybeExpression) ((_toIself) :: MaybeExpression) -> + Expression_Enum _rangeIself _fromIself _thenIself _toIself + {-# INLINE rule121 #-} + rule121 = \ _self -> + _self +{-# NOINLINE sem_Expression_Negate #-} +sem_Expression_Negate :: T_Range -> T_Expression -> T_Expression +sem_Expression_Negate arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule122 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule123 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule122 #-} + rule122 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Negate _rangeIself _expressionIself + {-# INLINE rule123 #-} + rule123 = \ _self -> + _self +{-# NOINLINE sem_Expression_NegateFloat #-} +sem_Expression_NegateFloat :: T_Range -> T_Expression -> T_Expression +sem_Expression_NegateFloat arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule124 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule125 _self + __result_ = T_Expression_vOut40 _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule124 #-} + rule124 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NegateFloat _rangeIself _expressionIself + {-# INLINE rule125 #-} + rule125 = \ _self -> + _self + +-- Expressions ------------------------------------------------- +-- wrapper +data Inh_Expressions = Inh_Expressions { } +data Syn_Expressions = Syn_Expressions { self_Syn_Expressions :: (Expressions) } +{-# INLINABLE wrap_Expressions #-} +wrap_Expressions :: T_Expressions -> Inh_Expressions -> (Syn_Expressions ) +wrap_Expressions (T_Expressions act) (Inh_Expressions ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expressions_vIn43 + (T_Expressions_vOut43 _lhsOself) <- return (inv_Expressions_s44 sem arg) + return (Syn_Expressions _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expressions #-} +sem_Expressions :: Expressions -> T_Expressions +sem_Expressions list = Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list) + +-- semantic domain +newtype T_Expressions = T_Expressions { + attach_T_Expressions :: Identity (T_Expressions_s44 ) + } +newtype T_Expressions_s44 = C_Expressions_s44 { + inv_Expressions_s44 :: (T_Expressions_v43 ) + } +data T_Expressions_s45 = C_Expressions_s45 +type T_Expressions_v43 = (T_Expressions_vIn43 ) -> (T_Expressions_vOut43 ) +data T_Expressions_vIn43 = T_Expressions_vIn43 +data T_Expressions_vOut43 = T_Expressions_vOut43 (Expressions) +{-# NOINLINE sem_Expressions_Cons #-} +sem_Expressions_Cons :: T_Expression -> T_Expressions -> T_Expressions +sem_Expressions_Cons arg_hd_ arg_tl_ = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 ) -> ( let + _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_hd_)) + _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_tl_)) + (T_Expression_vOut40 _hdIself) = inv_Expression_s41 _hdX41 (T_Expression_vIn40 ) + (T_Expressions_vOut43 _tlIself) = inv_Expressions_s44 _tlX44 (T_Expressions_vIn43 ) + _self = rule126 _hdIself _tlIself + _lhsOself :: Expressions + _lhsOself = rule127 _self + __result_ = T_Expressions_vOut43 _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule126 #-} + rule126 = \ ((_hdIself) :: Expression) ((_tlIself) :: Expressions) -> + (:) _hdIself _tlIself + {-# INLINE rule127 #-} + rule127 = \ _self -> + _self +{-# NOINLINE sem_Expressions_Nil #-} +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 ) -> ( let + _self = rule128 () + _lhsOself :: Expressions + _lhsOself = rule129 _self + __result_ = T_Expressions_vOut43 _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule128 #-} + rule128 = \ (_ :: ()) -> + [] + {-# INLINE rule129 #-} + rule129 = \ _self -> + _self + +-- FieldDeclaration -------------------------------------------- +-- wrapper +data Inh_FieldDeclaration = Inh_FieldDeclaration { } +data Syn_FieldDeclaration = Syn_FieldDeclaration { self_Syn_FieldDeclaration :: (FieldDeclaration) } +{-# INLINABLE wrap_FieldDeclaration #-} +wrap_FieldDeclaration :: T_FieldDeclaration -> Inh_FieldDeclaration -> (Syn_FieldDeclaration ) +wrap_FieldDeclaration (T_FieldDeclaration act) (Inh_FieldDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclaration_vIn46 + (T_FieldDeclaration_vOut46 _lhsOself) <- return (inv_FieldDeclaration_s47 sem arg) + return (Syn_FieldDeclaration _lhsOself) + ) + +-- cata +{-# INLINE sem_FieldDeclaration #-} +sem_FieldDeclaration :: FieldDeclaration -> T_FieldDeclaration +sem_FieldDeclaration ( FieldDeclaration_FieldDeclaration range_ names_ type_ ) = sem_FieldDeclaration_FieldDeclaration ( sem_Range range_ ) ( sem_Names names_ ) ( sem_AnnotatedType type_ ) + +-- semantic domain +newtype T_FieldDeclaration = T_FieldDeclaration { + attach_T_FieldDeclaration :: Identity (T_FieldDeclaration_s47 ) + } +newtype T_FieldDeclaration_s47 = C_FieldDeclaration_s47 { + inv_FieldDeclaration_s47 :: (T_FieldDeclaration_v46 ) + } +data T_FieldDeclaration_s48 = C_FieldDeclaration_s48 +type T_FieldDeclaration_v46 = (T_FieldDeclaration_vIn46 ) -> (T_FieldDeclaration_vOut46 ) +data T_FieldDeclaration_vIn46 = T_FieldDeclaration_vIn46 +data T_FieldDeclaration_vOut46 = T_FieldDeclaration_vOut46 (FieldDeclaration) +{-# NOINLINE sem_FieldDeclaration_FieldDeclaration #-} +sem_FieldDeclaration_FieldDeclaration :: T_Range -> T_Names -> T_AnnotatedType -> T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration arg_range_ arg_names_ arg_type_ = T_FieldDeclaration (return st47) where + {-# NOINLINE st47 #-} + st47 = let + v46 :: T_FieldDeclaration_v46 + v46 = \ (T_FieldDeclaration_vIn46 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesInames _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_AnnotatedType_vOut7 _typeIself) = inv_AnnotatedType_s8 _typeX8 (T_AnnotatedType_vIn7 ) + _self = rule130 _namesIself _rangeIself _typeIself + _lhsOself :: FieldDeclaration + _lhsOself = rule131 _self + __result_ = T_FieldDeclaration_vOut46 _lhsOself + in __result_ ) + in C_FieldDeclaration_s47 v46 + {-# INLINE rule130 #-} + rule130 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: AnnotatedType) -> + FieldDeclaration_FieldDeclaration _rangeIself _namesIself _typeIself + {-# INLINE rule131 #-} + rule131 = \ _self -> + _self + +-- FieldDeclarations ------------------------------------------- +-- wrapper +data Inh_FieldDeclarations = Inh_FieldDeclarations { } +data Syn_FieldDeclarations = Syn_FieldDeclarations { self_Syn_FieldDeclarations :: (FieldDeclarations) } +{-# INLINABLE wrap_FieldDeclarations #-} +wrap_FieldDeclarations :: T_FieldDeclarations -> Inh_FieldDeclarations -> (Syn_FieldDeclarations ) +wrap_FieldDeclarations (T_FieldDeclarations act) (Inh_FieldDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclarations_vIn49 + (T_FieldDeclarations_vOut49 _lhsOself) <- return (inv_FieldDeclarations_s50 sem arg) + return (Syn_FieldDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FieldDeclarations #-} +sem_FieldDeclarations :: FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations list = Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list) + +-- semantic domain +newtype T_FieldDeclarations = T_FieldDeclarations { + attach_T_FieldDeclarations :: Identity (T_FieldDeclarations_s50 ) + } +newtype T_FieldDeclarations_s50 = C_FieldDeclarations_s50 { + inv_FieldDeclarations_s50 :: (T_FieldDeclarations_v49 ) + } +data T_FieldDeclarations_s51 = C_FieldDeclarations_s51 +type T_FieldDeclarations_v49 = (T_FieldDeclarations_vIn49 ) -> (T_FieldDeclarations_vOut49 ) +data T_FieldDeclarations_vIn49 = T_FieldDeclarations_vIn49 +data T_FieldDeclarations_vOut49 = T_FieldDeclarations_vOut49 (FieldDeclarations) +{-# NOINLINE sem_FieldDeclarations_Cons #-} +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> T_FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations_Cons arg_hd_ arg_tl_ = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _hdX47 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclaration (arg_hd_)) + _tlX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_tl_)) + (T_FieldDeclaration_vOut46 _hdIself) = inv_FieldDeclaration_s47 _hdX47 (T_FieldDeclaration_vIn46 ) + (T_FieldDeclarations_vOut49 _tlIself) = inv_FieldDeclarations_s50 _tlX50 (T_FieldDeclarations_vIn49 ) + _self = rule132 _hdIself _tlIself + _lhsOself :: FieldDeclarations + _lhsOself = rule133 _self + __result_ = T_FieldDeclarations_vOut49 _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule132 #-} + rule132 = \ ((_hdIself) :: FieldDeclaration) ((_tlIself) :: FieldDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule133 #-} + rule133 = \ _self -> + _self +{-# NOINLINE sem_FieldDeclarations_Nil #-} +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _self = rule134 () + _lhsOself :: FieldDeclarations + _lhsOself = rule135 _self + __result_ = T_FieldDeclarations_vOut49 _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule134 #-} + rule134 = \ (_ :: ()) -> + [] + {-# INLINE rule135 #-} + rule135 = \ _self -> + _self + +-- Fixity ------------------------------------------------------ +-- wrapper +data Inh_Fixity = Inh_Fixity { } +data Syn_Fixity = Syn_Fixity { self_Syn_Fixity :: (Fixity) } +{-# INLINABLE wrap_Fixity #-} +wrap_Fixity :: T_Fixity -> Inh_Fixity -> (Syn_Fixity ) +wrap_Fixity (T_Fixity act) (Inh_Fixity ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Fixity_vIn52 + (T_Fixity_vOut52 _lhsOself) <- return (inv_Fixity_s53 sem arg) + return (Syn_Fixity _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Fixity #-} +sem_Fixity :: Fixity -> T_Fixity +sem_Fixity ( Fixity_Infixl range_ ) = sem_Fixity_Infixl ( sem_Range range_ ) +sem_Fixity ( Fixity_Infixr range_ ) = sem_Fixity_Infixr ( sem_Range range_ ) +sem_Fixity ( Fixity_Infix range_ ) = sem_Fixity_Infix ( sem_Range range_ ) + +-- semantic domain +newtype T_Fixity = T_Fixity { + attach_T_Fixity :: Identity (T_Fixity_s53 ) + } +newtype T_Fixity_s53 = C_Fixity_s53 { + inv_Fixity_s53 :: (T_Fixity_v52 ) + } +data T_Fixity_s54 = C_Fixity_s54 +type T_Fixity_v52 = (T_Fixity_vIn52 ) -> (T_Fixity_vOut52 ) +data T_Fixity_vIn52 = T_Fixity_vIn52 +data T_Fixity_vOut52 = T_Fixity_vOut52 (Fixity) +{-# NOINLINE sem_Fixity_Infixl #-} +sem_Fixity_Infixl :: T_Range -> T_Fixity +sem_Fixity_Infixl arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule136 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule137 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule136 #-} + rule136 = \ ((_rangeIself) :: Range) -> + Fixity_Infixl _rangeIself + {-# INLINE rule137 #-} + rule137 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infixr #-} +sem_Fixity_Infixr :: T_Range -> T_Fixity +sem_Fixity_Infixr arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule138 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule139 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule138 #-} + rule138 = \ ((_rangeIself) :: Range) -> + Fixity_Infixr _rangeIself + {-# INLINE rule139 #-} + rule139 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infix #-} +sem_Fixity_Infix :: T_Range -> T_Fixity +sem_Fixity_Infix arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule140 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule141 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule140 #-} + rule140 = \ ((_rangeIself) :: Range) -> + Fixity_Infix _rangeIself + {-# INLINE rule141 #-} + rule141 = \ _self -> + _self + +-- FunctionBinding --------------------------------------------- +-- wrapper +data Inh_FunctionBinding = Inh_FunctionBinding { } +data Syn_FunctionBinding = Syn_FunctionBinding { name_Syn_FunctionBinding :: (Name), self_Syn_FunctionBinding :: (FunctionBinding) } +{-# INLINABLE wrap_FunctionBinding #-} +wrap_FunctionBinding :: T_FunctionBinding -> Inh_FunctionBinding -> (Syn_FunctionBinding ) +wrap_FunctionBinding (T_FunctionBinding act) (Inh_FunctionBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBinding_vIn55 + (T_FunctionBinding_vOut55 _lhsOname _lhsOself) <- return (inv_FunctionBinding_s56 sem arg) + return (Syn_FunctionBinding _lhsOname _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBinding #-} +sem_FunctionBinding :: FunctionBinding -> T_FunctionBinding +sem_FunctionBinding ( FunctionBinding_Hole range_ id_ ) = sem_FunctionBinding_Hole ( sem_Range range_ ) id_ +sem_FunctionBinding ( FunctionBinding_Feedback range_ feedback_ functionBinding_ ) = sem_FunctionBinding_Feedback ( sem_Range range_ ) feedback_ ( sem_FunctionBinding functionBinding_ ) +sem_FunctionBinding ( FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ ) = sem_FunctionBinding_FunctionBinding ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_RightHandSide righthandside_ ) + +-- semantic domain +newtype T_FunctionBinding = T_FunctionBinding { + attach_T_FunctionBinding :: Identity (T_FunctionBinding_s56 ) + } +newtype T_FunctionBinding_s56 = C_FunctionBinding_s56 { + inv_FunctionBinding_s56 :: (T_FunctionBinding_v55 ) + } +data T_FunctionBinding_s57 = C_FunctionBinding_s57 +type T_FunctionBinding_v55 = (T_FunctionBinding_vIn55 ) -> (T_FunctionBinding_vOut55 ) +data T_FunctionBinding_vIn55 = T_FunctionBinding_vIn55 +data T_FunctionBinding_vOut55 = T_FunctionBinding_vOut55 (Name) (FunctionBinding) +{-# NOINLINE sem_FunctionBinding_Hole #-} +sem_FunctionBinding_Hole :: T_Range -> (Integer) -> T_FunctionBinding +sem_FunctionBinding_Hole arg_range_ arg_id_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOname :: Name + _lhsOname = rule142 () + _self = rule143 _rangeIself arg_id_ + _lhsOself :: FunctionBinding + _lhsOself = rule144 _self + __result_ = T_FunctionBinding_vOut55 _lhsOname _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule142 #-} + rule142 = \ (_ :: ()) -> + internalError "ToCoreName.ag" "n/a" "hole FunctionBindings" + {-# INLINE rule143 #-} + rule143 = \ ((_rangeIself) :: Range) id_ -> + FunctionBinding_Hole _rangeIself id_ + {-# INLINE rule144 #-} + rule144 = \ _self -> + _self +{-# NOINLINE sem_FunctionBinding_Feedback #-} +sem_FunctionBinding_Feedback :: T_Range -> (String) -> T_FunctionBinding -> T_FunctionBinding +sem_FunctionBinding_Feedback arg_range_ arg_feedback_ arg_functionBinding_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionBindingX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_functionBinding_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBinding_vOut55 _functionBindingIname _functionBindingIself) = inv_FunctionBinding_s56 _functionBindingX56 (T_FunctionBinding_vIn55 ) + _self = rule145 _functionBindingIself _rangeIself arg_feedback_ + _lhsOself :: FunctionBinding + _lhsOself = rule146 _self + _lhsOname :: Name + _lhsOname = rule147 _functionBindingIname + __result_ = T_FunctionBinding_vOut55 _lhsOname _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule145 #-} + rule145 = \ ((_functionBindingIself) :: FunctionBinding) ((_rangeIself) :: Range) feedback_ -> + FunctionBinding_Feedback _rangeIself feedback_ _functionBindingIself + {-# INLINE rule146 #-} + rule146 = \ _self -> + _self + {-# INLINE rule147 #-} + rule147 = \ ((_functionBindingIname) :: Name) -> + _functionBindingIname +{-# NOINLINE sem_FunctionBinding_FunctionBinding #-} +sem_FunctionBinding_FunctionBinding :: T_Range -> T_LeftHandSide -> T_RightHandSide -> T_FunctionBinding +sem_FunctionBinding_FunctionBinding arg_range_ arg_lefthandside_ arg_righthandside_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIname _lefthandsideIself) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 ) + (T_RightHandSide_vOut148 _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 ) + _self = rule148 _lefthandsideIself _rangeIself _righthandsideIself + _lhsOself :: FunctionBinding + _lhsOself = rule149 _self + _lhsOname :: Name + _lhsOname = rule150 _lefthandsideIname + __result_ = T_FunctionBinding_vOut55 _lhsOname _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule148 #-} + rule148 = \ ((_lefthandsideIself) :: LeftHandSide) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + FunctionBinding_FunctionBinding _rangeIself _lefthandsideIself _righthandsideIself + {-# INLINE rule149 #-} + rule149 = \ _self -> + _self + {-# INLINE rule150 #-} + rule150 = \ ((_lefthandsideIname) :: Name) -> + _lefthandsideIname + +-- FunctionBindings -------------------------------------------- +-- wrapper +data Inh_FunctionBindings = Inh_FunctionBindings { } +data Syn_FunctionBindings = Syn_FunctionBindings { name_Syn_FunctionBindings :: (Name), self_Syn_FunctionBindings :: (FunctionBindings) } +{-# INLINABLE wrap_FunctionBindings #-} +wrap_FunctionBindings :: T_FunctionBindings -> Inh_FunctionBindings -> (Syn_FunctionBindings ) +wrap_FunctionBindings (T_FunctionBindings act) (Inh_FunctionBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBindings_vIn58 + (T_FunctionBindings_vOut58 _lhsOname _lhsOself) <- return (inv_FunctionBindings_s59 sem arg) + return (Syn_FunctionBindings _lhsOname _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBindings #-} +sem_FunctionBindings :: FunctionBindings -> T_FunctionBindings +sem_FunctionBindings list = Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list) + +-- semantic domain +newtype T_FunctionBindings = T_FunctionBindings { + attach_T_FunctionBindings :: Identity (T_FunctionBindings_s59 ) + } +newtype T_FunctionBindings_s59 = C_FunctionBindings_s59 { + inv_FunctionBindings_s59 :: (T_FunctionBindings_v58 ) + } +data T_FunctionBindings_s60 = C_FunctionBindings_s60 +type T_FunctionBindings_v58 = (T_FunctionBindings_vIn58 ) -> (T_FunctionBindings_vOut58 ) +data T_FunctionBindings_vIn58 = T_FunctionBindings_vIn58 +data T_FunctionBindings_vOut58 = T_FunctionBindings_vOut58 (Name) (FunctionBindings) +{-# NOINLINE sem_FunctionBindings_Cons #-} +sem_FunctionBindings_Cons :: T_FunctionBinding -> T_FunctionBindings -> T_FunctionBindings +sem_FunctionBindings_Cons arg_hd_ arg_tl_ = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 ) -> ( let + _hdX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_hd_)) + _tlX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_tl_)) + (T_FunctionBinding_vOut55 _hdIname _hdIself) = inv_FunctionBinding_s56 _hdX56 (T_FunctionBinding_vIn55 ) + (T_FunctionBindings_vOut58 _tlIname _tlIself) = inv_FunctionBindings_s59 _tlX59 (T_FunctionBindings_vIn58 ) + _lhsOname :: Name + _lhsOname = rule151 _hdIname + _self = rule152 _hdIself _tlIself + _lhsOself :: FunctionBindings + _lhsOself = rule153 _self + __result_ = T_FunctionBindings_vOut58 _lhsOname _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule151 #-} + rule151 = \ ((_hdIname) :: Name) -> + _hdIname + {-# INLINE rule152 #-} + rule152 = \ ((_hdIself) :: FunctionBinding) ((_tlIself) :: FunctionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule153 #-} + rule153 = \ _self -> + _self +{-# NOINLINE sem_FunctionBindings_Nil #-} +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 ) -> ( let + _lhsOname :: Name + _lhsOname = rule154 () + _self = rule155 () + _lhsOself :: FunctionBindings + _lhsOself = rule156 _self + __result_ = T_FunctionBindings_vOut58 _lhsOname _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule154 #-} + rule154 = \ (_ :: ()) -> + internalError "ToCoreName.ag" "n/a" "empty FunctionBindings" + {-# INLINE rule155 #-} + rule155 = \ (_ :: ()) -> + [] + {-# INLINE rule156 #-} + rule156 = \ _self -> + _self + +-- GuardedExpression ------------------------------------------- +-- wrapper +data Inh_GuardedExpression = Inh_GuardedExpression { } +data Syn_GuardedExpression = Syn_GuardedExpression { self_Syn_GuardedExpression :: (GuardedExpression) } +{-# INLINABLE wrap_GuardedExpression #-} +wrap_GuardedExpression :: T_GuardedExpression -> Inh_GuardedExpression -> (Syn_GuardedExpression ) +wrap_GuardedExpression (T_GuardedExpression act) (Inh_GuardedExpression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpression_vIn61 + (T_GuardedExpression_vOut61 _lhsOself) <- return (inv_GuardedExpression_s62 sem arg) + return (Syn_GuardedExpression _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpression #-} +sem_GuardedExpression :: GuardedExpression -> T_GuardedExpression +sem_GuardedExpression ( GuardedExpression_GuardedExpression range_ guard_ expression_ ) = sem_GuardedExpression_GuardedExpression ( sem_Range range_ ) ( sem_Expression guard_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_GuardedExpression = T_GuardedExpression { + attach_T_GuardedExpression :: Identity (T_GuardedExpression_s62 ) + } +newtype T_GuardedExpression_s62 = C_GuardedExpression_s62 { + inv_GuardedExpression_s62 :: (T_GuardedExpression_v61 ) + } +data T_GuardedExpression_s63 = C_GuardedExpression_s63 +type T_GuardedExpression_v61 = (T_GuardedExpression_vIn61 ) -> (T_GuardedExpression_vOut61 ) +data T_GuardedExpression_vIn61 = T_GuardedExpression_vIn61 +data T_GuardedExpression_vOut61 = T_GuardedExpression_vOut61 (GuardedExpression) +{-# NOINLINE sem_GuardedExpression_GuardedExpression #-} +sem_GuardedExpression_GuardedExpression :: T_Range -> T_Expression -> T_Expression -> T_GuardedExpression +sem_GuardedExpression_GuardedExpression arg_range_ arg_guard_ arg_expression_ = T_GuardedExpression (return st62) where + {-# NOINLINE st62 #-} + st62 = let + v61 :: T_GuardedExpression_v61 + v61 = \ (T_GuardedExpression_vIn61 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule157 _expressionIself _guardIself _rangeIself + _lhsOself :: GuardedExpression + _lhsOself = rule158 _self + __result_ = T_GuardedExpression_vOut61 _lhsOself + in __result_ ) + in C_GuardedExpression_s62 v61 + {-# INLINE rule157 #-} + rule157 = \ ((_expressionIself) :: Expression) ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + GuardedExpression_GuardedExpression _rangeIself _guardIself _expressionIself + {-# INLINE rule158 #-} + rule158 = \ _self -> + _self + +-- GuardedExpressions ------------------------------------------ +-- wrapper +data Inh_GuardedExpressions = Inh_GuardedExpressions { } +data Syn_GuardedExpressions = Syn_GuardedExpressions { self_Syn_GuardedExpressions :: (GuardedExpressions) } +{-# INLINABLE wrap_GuardedExpressions #-} +wrap_GuardedExpressions :: T_GuardedExpressions -> Inh_GuardedExpressions -> (Syn_GuardedExpressions ) +wrap_GuardedExpressions (T_GuardedExpressions act) (Inh_GuardedExpressions ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpressions_vIn64 + (T_GuardedExpressions_vOut64 _lhsOself) <- return (inv_GuardedExpressions_s65 sem arg) + return (Syn_GuardedExpressions _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpressions #-} +sem_GuardedExpressions :: GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions list = Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list) + +-- semantic domain +newtype T_GuardedExpressions = T_GuardedExpressions { + attach_T_GuardedExpressions :: Identity (T_GuardedExpressions_s65 ) + } +newtype T_GuardedExpressions_s65 = C_GuardedExpressions_s65 { + inv_GuardedExpressions_s65 :: (T_GuardedExpressions_v64 ) + } +data T_GuardedExpressions_s66 = C_GuardedExpressions_s66 +type T_GuardedExpressions_v64 = (T_GuardedExpressions_vIn64 ) -> (T_GuardedExpressions_vOut64 ) +data T_GuardedExpressions_vIn64 = T_GuardedExpressions_vIn64 +data T_GuardedExpressions_vOut64 = T_GuardedExpressions_vOut64 (GuardedExpressions) +{-# NOINLINE sem_GuardedExpressions_Cons #-} +sem_GuardedExpressions_Cons :: T_GuardedExpression -> T_GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions_Cons arg_hd_ arg_tl_ = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 ) -> ( let + _hdX62 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpression (arg_hd_)) + _tlX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_tl_)) + (T_GuardedExpression_vOut61 _hdIself) = inv_GuardedExpression_s62 _hdX62 (T_GuardedExpression_vIn61 ) + (T_GuardedExpressions_vOut64 _tlIself) = inv_GuardedExpressions_s65 _tlX65 (T_GuardedExpressions_vIn64 ) + _self = rule159 _hdIself _tlIself + _lhsOself :: GuardedExpressions + _lhsOself = rule160 _self + __result_ = T_GuardedExpressions_vOut64 _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule159 #-} + rule159 = \ ((_hdIself) :: GuardedExpression) ((_tlIself) :: GuardedExpressions) -> + (:) _hdIself _tlIself + {-# INLINE rule160 #-} + rule160 = \ _self -> + _self +{-# NOINLINE sem_GuardedExpressions_Nil #-} +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 ) -> ( let + _self = rule161 () + _lhsOself :: GuardedExpressions + _lhsOself = rule162 _self + __result_ = T_GuardedExpressions_vOut64 _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule161 #-} + rule161 = \ (_ :: ()) -> + [] + {-# INLINE rule162 #-} + rule162 = \ _self -> + _self + +-- Import ------------------------------------------------------ +-- wrapper +data Inh_Import = Inh_Import { } +data Syn_Import = Syn_Import { imps_Syn_Import :: ([Id]), self_Syn_Import :: (Import) } +{-# INLINABLE wrap_Import #-} +wrap_Import :: T_Import -> Inh_Import -> (Syn_Import ) +wrap_Import (T_Import act) (Inh_Import ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Import_vIn67 + (T_Import_vOut67 _lhsOimps _lhsOself) <- return (inv_Import_s68 sem arg) + return (Syn_Import _lhsOimps _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Import #-} +sem_Import :: Import -> T_Import +sem_Import ( Import_Variable range_ name_ ) = sem_Import_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Import ( Import_TypeOrClass range_ name_ names_ ) = sem_Import_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Import ( Import_TypeOrClassComplete range_ name_ ) = sem_Import_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Import = T_Import { + attach_T_Import :: Identity (T_Import_s68 ) + } +newtype T_Import_s68 = C_Import_s68 { + inv_Import_s68 :: (T_Import_v67 ) + } +data T_Import_s69 = C_Import_s69 +type T_Import_v67 = (T_Import_vIn67 ) -> (T_Import_vOut67 ) +data T_Import_vIn67 = T_Import_vIn67 +data T_Import_vOut67 = T_Import_vOut67 ([Id]) (Import) +{-# NOINLINE sem_Import_Variable #-} +sem_Import_Variable :: T_Range -> T_Name -> T_Import +sem_Import_Variable arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOimps :: [Id] + _lhsOimps = rule163 _nameIself + _self = rule164 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule165 _self + __result_ = T_Import_vOut67 _lhsOimps _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule163 #-} + rule163 = \ ((_nameIself) :: Name) -> + [idFromName _nameIself] + {-# INLINE rule164 #-} + rule164 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_Variable _rangeIself _nameIself + {-# INLINE rule165 #-} + rule165 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClass #-} +sem_Import_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Import +sem_Import_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesInames _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _lhsOimps :: [Id] + _lhsOimps = rule166 () + _self = rule167 _nameIself _namesIself _rangeIself + _lhsOself :: Import + _lhsOself = rule168 _self + __result_ = T_Import_vOut67 _lhsOimps _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule166 #-} + rule166 = \ (_ :: ()) -> + internalError "ExtractImportDecls.ag" "ImportSpecification.Import" "only variables can be hidden" + {-# INLINE rule167 #-} + rule167 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Import_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule168 #-} + rule168 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClassComplete #-} +sem_Import_TypeOrClassComplete :: T_Range -> T_Name -> T_Import +sem_Import_TypeOrClassComplete arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOimps :: [Id] + _lhsOimps = rule169 () + _self = rule170 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule171 _self + __result_ = T_Import_vOut67 _lhsOimps _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule169 #-} + rule169 = \ (_ :: ()) -> + internalError "ExtractImportDecls.ag" "ImportSpecification.Import" "only variables can be hidden" + {-# INLINE rule170 #-} + rule170 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule171 #-} + rule171 = \ _self -> + _self + +-- ImportDeclaration ------------------------------------------- +-- wrapper +data Inh_ImportDeclaration = Inh_ImportDeclaration { } +data Syn_ImportDeclaration = Syn_ImportDeclaration { coreImportDecls_Syn_ImportDeclaration :: ( [(Core.CoreDecl,[Id])] ), self_Syn_ImportDeclaration :: (ImportDeclaration) } +{-# INLINABLE wrap_ImportDeclaration #-} +wrap_ImportDeclaration :: T_ImportDeclaration -> Inh_ImportDeclaration -> (Syn_ImportDeclaration ) +wrap_ImportDeclaration (T_ImportDeclaration act) (Inh_ImportDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclaration_vIn70 + (T_ImportDeclaration_vOut70 _lhsOcoreImportDecls _lhsOself) <- return (inv_ImportDeclaration_s71 sem arg) + return (Syn_ImportDeclaration _lhsOcoreImportDecls _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclaration #-} +sem_ImportDeclaration :: ImportDeclaration -> T_ImportDeclaration +sem_ImportDeclaration ( ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ ) = sem_ImportDeclaration_Import ( sem_Range range_ ) qualified_ ( sem_Name name_ ) ( sem_MaybeName asname_ ) ( sem_MaybeImportSpecification importspecification_ ) +sem_ImportDeclaration ( ImportDeclaration_Empty range_ ) = sem_ImportDeclaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_ImportDeclaration = T_ImportDeclaration { + attach_T_ImportDeclaration :: Identity (T_ImportDeclaration_s71 ) + } +newtype T_ImportDeclaration_s71 = C_ImportDeclaration_s71 { + inv_ImportDeclaration_s71 :: (T_ImportDeclaration_v70 ) + } +data T_ImportDeclaration_s72 = C_ImportDeclaration_s72 +type T_ImportDeclaration_v70 = (T_ImportDeclaration_vIn70 ) -> (T_ImportDeclaration_vOut70 ) +data T_ImportDeclaration_vIn70 = T_ImportDeclaration_vIn70 +data T_ImportDeclaration_vOut70 = T_ImportDeclaration_vOut70 ( [(Core.CoreDecl,[Id])] ) (ImportDeclaration) +{-# NOINLINE sem_ImportDeclaration_Import #-} +sem_ImportDeclaration_Import :: T_Range -> (Bool) -> T_Name -> T_MaybeName -> T_MaybeImportSpecification -> T_ImportDeclaration +sem_ImportDeclaration_Import arg_range_ arg_qualified_ arg_name_ arg_asname_ arg_importspecification_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _asnameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_asname_)) + _importspecificationX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeImportSpecification (arg_importspecification_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeName_vOut103 _asnameIisNothing _asnameIname _asnameIself) = inv_MaybeName_s104 _asnameX104 (T_MaybeName_vIn103 ) + (T_MaybeImportSpecification_vOut97 _importspecificationIimps _importspecificationIself) = inv_MaybeImportSpecification_s98 _importspecificationX98 (T_MaybeImportSpecification_vIn97 ) + _lhsOcoreImportDecls :: [(Core.CoreDecl,[Id])] + _lhsOcoreImportDecls = rule172 _hidings _importDecls + _importDecls = rule173 _asnameIisNothing _nameIself arg_qualified_ + _hidings = rule174 _importspecificationIimps + _self = rule175 _asnameIself _importspecificationIself _nameIself _rangeIself arg_qualified_ + _lhsOself :: ImportDeclaration + _lhsOself = rule176 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOcoreImportDecls _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule172 #-} + rule172 = \ _hidings _importDecls -> + [(_importDecls ,_hidings )] + {-# INLINE rule173 #-} + rule173 = \ ((_asnameIisNothing) :: Bool) ((_nameIself) :: Name) qualified_ -> + if qualified_ || not _asnameIisNothing then + internalError "ExtractImportDecls.ag" "ImportDeclaration.Import" "qualified and as-imports not supported yet" + else + Core.DeclImport + { Core.declName = idFromName _nameIself + , Core.declAccess = + Core.Imported + { Core.accessPublic = False + , Core.importModule = idFromName _nameIself + , Core.importName = dummyId + , Core.importKind = Core.DeclKindModule + , Core.importMajorVer = 0 + , Core.importMinorVer = 0 + } + , Core.declCustoms = [] + } + {-# INLINE rule174 #-} + rule174 = \ ((_importspecificationIimps) :: [Id]) -> + _importspecificationIimps + {-# INLINE rule175 #-} + rule175 = \ ((_asnameIself) :: MaybeName) ((_importspecificationIself) :: MaybeImportSpecification) ((_nameIself) :: Name) ((_rangeIself) :: Range) qualified_ -> + ImportDeclaration_Import _rangeIself qualified_ _nameIself _asnameIself _importspecificationIself + {-# INLINE rule176 #-} + rule176 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclaration_Empty #-} +sem_ImportDeclaration_Empty :: T_Range -> T_ImportDeclaration +sem_ImportDeclaration_Empty arg_range_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcoreImportDecls :: [(Core.CoreDecl,[Id])] + _lhsOcoreImportDecls = rule177 () + _self = rule178 _rangeIself + _lhsOself :: ImportDeclaration + _lhsOself = rule179 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOcoreImportDecls _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule177 #-} + rule177 = \ (_ :: ()) -> + [] + {-# INLINE rule178 #-} + rule178 = \ ((_rangeIself) :: Range) -> + ImportDeclaration_Empty _rangeIself + {-# INLINE rule179 #-} + rule179 = \ _self -> + _self + +-- ImportDeclarations ------------------------------------------ +-- wrapper +data Inh_ImportDeclarations = Inh_ImportDeclarations { } +data Syn_ImportDeclarations = Syn_ImportDeclarations { coreImportDecls_Syn_ImportDeclarations :: ( [(Core.CoreDecl,[Id])] ), self_Syn_ImportDeclarations :: (ImportDeclarations) } +{-# INLINABLE wrap_ImportDeclarations #-} +wrap_ImportDeclarations :: T_ImportDeclarations -> Inh_ImportDeclarations -> (Syn_ImportDeclarations ) +wrap_ImportDeclarations (T_ImportDeclarations act) (Inh_ImportDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclarations_vIn73 + (T_ImportDeclarations_vOut73 _lhsOcoreImportDecls _lhsOself) <- return (inv_ImportDeclarations_s74 sem arg) + return (Syn_ImportDeclarations _lhsOcoreImportDecls _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclarations #-} +sem_ImportDeclarations :: ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations list = Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list) + +-- semantic domain +newtype T_ImportDeclarations = T_ImportDeclarations { + attach_T_ImportDeclarations :: Identity (T_ImportDeclarations_s74 ) + } +newtype T_ImportDeclarations_s74 = C_ImportDeclarations_s74 { + inv_ImportDeclarations_s74 :: (T_ImportDeclarations_v73 ) + } +data T_ImportDeclarations_s75 = C_ImportDeclarations_s75 +type T_ImportDeclarations_v73 = (T_ImportDeclarations_vIn73 ) -> (T_ImportDeclarations_vOut73 ) +data T_ImportDeclarations_vIn73 = T_ImportDeclarations_vIn73 +data T_ImportDeclarations_vOut73 = T_ImportDeclarations_vOut73 ( [(Core.CoreDecl,[Id])] ) (ImportDeclarations) +{-# NOINLINE sem_ImportDeclarations_Cons #-} +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> T_ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations_Cons arg_hd_ arg_tl_ = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _hdX71 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclaration (arg_hd_)) + _tlX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_tl_)) + (T_ImportDeclaration_vOut70 _hdIcoreImportDecls _hdIself) = inv_ImportDeclaration_s71 _hdX71 (T_ImportDeclaration_vIn70 ) + (T_ImportDeclarations_vOut73 _tlIcoreImportDecls _tlIself) = inv_ImportDeclarations_s74 _tlX74 (T_ImportDeclarations_vIn73 ) + _lhsOcoreImportDecls :: [(Core.CoreDecl,[Id])] + _lhsOcoreImportDecls = rule180 _hdIcoreImportDecls _tlIcoreImportDecls + _self = rule181 _hdIself _tlIself + _lhsOself :: ImportDeclarations + _lhsOself = rule182 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOcoreImportDecls _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule180 #-} + rule180 = \ ((_hdIcoreImportDecls) :: [(Core.CoreDecl,[Id])] ) ((_tlIcoreImportDecls) :: [(Core.CoreDecl,[Id])] ) -> + _hdIcoreImportDecls ++ _tlIcoreImportDecls + {-# INLINE rule181 #-} + rule181 = \ ((_hdIself) :: ImportDeclaration) ((_tlIself) :: ImportDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule182 #-} + rule182 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclarations_Nil #-} +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _lhsOcoreImportDecls :: [(Core.CoreDecl,[Id])] + _lhsOcoreImportDecls = rule183 () + _self = rule184 () + _lhsOself :: ImportDeclarations + _lhsOself = rule185 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOcoreImportDecls _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule183 #-} + rule183 = \ (_ :: ()) -> + [] + {-# INLINE rule184 #-} + rule184 = \ (_ :: ()) -> + [] + {-# INLINE rule185 #-} + rule185 = \ _self -> + _self + +-- ImportSpecification ----------------------------------------- +-- wrapper +data Inh_ImportSpecification = Inh_ImportSpecification { } +data Syn_ImportSpecification = Syn_ImportSpecification { imps_Syn_ImportSpecification :: ([Id]), self_Syn_ImportSpecification :: (ImportSpecification) } +{-# INLINABLE wrap_ImportSpecification #-} +wrap_ImportSpecification :: T_ImportSpecification -> Inh_ImportSpecification -> (Syn_ImportSpecification ) +wrap_ImportSpecification (T_ImportSpecification act) (Inh_ImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportSpecification_vIn76 + (T_ImportSpecification_vOut76 _lhsOimps _lhsOself) <- return (inv_ImportSpecification_s77 sem arg) + return (Syn_ImportSpecification _lhsOimps _lhsOself) + ) + +-- cata +{-# INLINE sem_ImportSpecification #-} +sem_ImportSpecification :: ImportSpecification -> T_ImportSpecification +sem_ImportSpecification ( ImportSpecification_Import range_ hiding_ imports_ ) = sem_ImportSpecification_Import ( sem_Range range_ ) hiding_ ( sem_Imports imports_ ) + +-- semantic domain +newtype T_ImportSpecification = T_ImportSpecification { + attach_T_ImportSpecification :: Identity (T_ImportSpecification_s77 ) + } +newtype T_ImportSpecification_s77 = C_ImportSpecification_s77 { + inv_ImportSpecification_s77 :: (T_ImportSpecification_v76 ) + } +data T_ImportSpecification_s78 = C_ImportSpecification_s78 +type T_ImportSpecification_v76 = (T_ImportSpecification_vIn76 ) -> (T_ImportSpecification_vOut76 ) +data T_ImportSpecification_vIn76 = T_ImportSpecification_vIn76 +data T_ImportSpecification_vOut76 = T_ImportSpecification_vOut76 ([Id]) (ImportSpecification) +{-# NOINLINE sem_ImportSpecification_Import #-} +sem_ImportSpecification_Import :: T_Range -> (Bool) -> T_Imports -> T_ImportSpecification +sem_ImportSpecification_Import arg_range_ arg_hiding_ arg_imports_ = T_ImportSpecification (return st77) where + {-# NOINLINE st77 #-} + st77 = let + v76 :: T_ImportSpecification_v76 + v76 = \ (T_ImportSpecification_vIn76 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importsX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_imports_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Imports_vOut79 _importsIimps _importsIself) = inv_Imports_s80 _importsX80 (T_Imports_vIn79 ) + _lhsOimps :: [Id] + _lhsOimps = rule186 _importsIimps arg_hiding_ + _self = rule187 _importsIself _rangeIself arg_hiding_ + _lhsOself :: ImportSpecification + _lhsOself = rule188 _self + __result_ = T_ImportSpecification_vOut76 _lhsOimps _lhsOself + in __result_ ) + in C_ImportSpecification_s77 v76 + {-# INLINE rule186 #-} + rule186 = \ ((_importsIimps) :: [Id]) hiding_ -> + if not hiding_ then + internalError "ExtractImportDecls.ag" "ImportSpecification.Import" "import lists are not supported" + else + _importsIimps + {-# INLINE rule187 #-} + rule187 = \ ((_importsIself) :: Imports) ((_rangeIself) :: Range) hiding_ -> + ImportSpecification_Import _rangeIself hiding_ _importsIself + {-# INLINE rule188 #-} + rule188 = \ _self -> + _self + +-- Imports ----------------------------------------------------- +-- wrapper +data Inh_Imports = Inh_Imports { } +data Syn_Imports = Syn_Imports { imps_Syn_Imports :: ([Id]), self_Syn_Imports :: (Imports) } +{-# INLINABLE wrap_Imports #-} +wrap_Imports :: T_Imports -> Inh_Imports -> (Syn_Imports ) +wrap_Imports (T_Imports act) (Inh_Imports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Imports_vIn79 + (T_Imports_vOut79 _lhsOimps _lhsOself) <- return (inv_Imports_s80 sem arg) + return (Syn_Imports _lhsOimps _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Imports #-} +sem_Imports :: Imports -> T_Imports +sem_Imports list = Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list) + +-- semantic domain +newtype T_Imports = T_Imports { + attach_T_Imports :: Identity (T_Imports_s80 ) + } +newtype T_Imports_s80 = C_Imports_s80 { + inv_Imports_s80 :: (T_Imports_v79 ) + } +data T_Imports_s81 = C_Imports_s81 +type T_Imports_v79 = (T_Imports_vIn79 ) -> (T_Imports_vOut79 ) +data T_Imports_vIn79 = T_Imports_vIn79 +data T_Imports_vOut79 = T_Imports_vOut79 ([Id]) (Imports) +{-# NOINLINE sem_Imports_Cons #-} +sem_Imports_Cons :: T_Import -> T_Imports -> T_Imports +sem_Imports_Cons arg_hd_ arg_tl_ = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _hdX68 = Control.Monad.Identity.runIdentity (attach_T_Import (arg_hd_)) + _tlX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_tl_)) + (T_Import_vOut67 _hdIimps _hdIself) = inv_Import_s68 _hdX68 (T_Import_vIn67 ) + (T_Imports_vOut79 _tlIimps _tlIself) = inv_Imports_s80 _tlX80 (T_Imports_vIn79 ) + _lhsOimps :: [Id] + _lhsOimps = rule189 _hdIimps _tlIimps + _self = rule190 _hdIself _tlIself + _lhsOself :: Imports + _lhsOself = rule191 _self + __result_ = T_Imports_vOut79 _lhsOimps _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule189 #-} + rule189 = \ ((_hdIimps) :: [Id]) ((_tlIimps) :: [Id]) -> + _hdIimps ++ _tlIimps + {-# INLINE rule190 #-} + rule190 = \ ((_hdIself) :: Import) ((_tlIself) :: Imports) -> + (:) _hdIself _tlIself + {-# INLINE rule191 #-} + rule191 = \ _self -> + _self +{-# NOINLINE sem_Imports_Nil #-} +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _lhsOimps :: [Id] + _lhsOimps = rule192 () + _self = rule193 () + _lhsOself :: Imports + _lhsOself = rule194 _self + __result_ = T_Imports_vOut79 _lhsOimps _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule192 #-} + rule192 = \ (_ :: ()) -> + [] + {-# INLINE rule193 #-} + rule193 = \ (_ :: ()) -> + [] + {-# INLINE rule194 #-} + rule194 = \ _self -> + _self + +-- LeftHandSide ------------------------------------------------ +-- wrapper +data Inh_LeftHandSide = Inh_LeftHandSide { } +data Syn_LeftHandSide = Syn_LeftHandSide { name_Syn_LeftHandSide :: (Name), self_Syn_LeftHandSide :: (LeftHandSide) } +{-# INLINABLE wrap_LeftHandSide #-} +wrap_LeftHandSide :: T_LeftHandSide -> Inh_LeftHandSide -> (Syn_LeftHandSide ) +wrap_LeftHandSide (T_LeftHandSide act) (Inh_LeftHandSide ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_LeftHandSide_vIn82 + (T_LeftHandSide_vOut82 _lhsOname _lhsOself) <- return (inv_LeftHandSide_s83 sem arg) + return (Syn_LeftHandSide _lhsOname _lhsOself) + ) + +-- cata +{-# NOINLINE sem_LeftHandSide #-} +sem_LeftHandSide :: LeftHandSide -> T_LeftHandSide +sem_LeftHandSide ( LeftHandSide_Function range_ name_ patterns_ ) = sem_LeftHandSide_Function ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_LeftHandSide ( LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ ) = sem_LeftHandSide_Infix ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name operator_ ) ( sem_Pattern rightPattern_ ) +sem_LeftHandSide ( LeftHandSide_Parenthesized range_ lefthandside_ patterns_ ) = sem_LeftHandSide_Parenthesized ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_Patterns patterns_ ) + +-- semantic domain +newtype T_LeftHandSide = T_LeftHandSide { + attach_T_LeftHandSide :: Identity (T_LeftHandSide_s83 ) + } +newtype T_LeftHandSide_s83 = C_LeftHandSide_s83 { + inv_LeftHandSide_s83 :: (T_LeftHandSide_v82 ) + } +data T_LeftHandSide_s84 = C_LeftHandSide_s84 +type T_LeftHandSide_v82 = (T_LeftHandSide_vIn82 ) -> (T_LeftHandSide_vOut82 ) +data T_LeftHandSide_vIn82 = T_LeftHandSide_vIn82 +data T_LeftHandSide_vOut82 = T_LeftHandSide_vOut82 (Name) (LeftHandSide) +{-# NOINLINE sem_LeftHandSide_Function #-} +sem_LeftHandSide_Function :: T_Range -> T_Name -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Function arg_range_ arg_name_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _lhsOname :: Name + _lhsOname = rule195 _nameIself + _self = rule196 _nameIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule197 _self + __result_ = T_LeftHandSide_vOut82 _lhsOname _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule195 #-} + rule195 = \ ((_nameIself) :: Name) -> + _nameIself + {-# INLINE rule196 #-} + rule196 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Function _rangeIself _nameIself _patternsIself + {-# INLINE rule197 #-} + rule197 = \ _self -> + _self +{-# NOINLINE sem_LeftHandSide_Infix #-} +sem_LeftHandSide_Infix :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_LeftHandSide +sem_LeftHandSide_Infix arg_range_ arg_leftPattern_ arg_operator_ arg_rightPattern_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _operatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_operator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIself) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 ) + (T_Name_vOut112 _operatorIself) = inv_Name_s113 _operatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIself) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 ) + _lhsOname :: Name + _lhsOname = rule198 _operatorIself + _self = rule199 _leftPatternIself _operatorIself _rangeIself _rightPatternIself + _lhsOself :: LeftHandSide + _lhsOself = rule200 _self + __result_ = T_LeftHandSide_vOut82 _lhsOname _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule198 #-} + rule198 = \ ((_operatorIself) :: Name) -> + _operatorIself + {-# INLINE rule199 #-} + rule199 = \ ((_leftPatternIself) :: Pattern) ((_operatorIself) :: Name) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + LeftHandSide_Infix _rangeIself _leftPatternIself _operatorIself _rightPatternIself + {-# INLINE rule200 #-} + rule200 = \ _self -> + _self +{-# NOINLINE sem_LeftHandSide_Parenthesized #-} +sem_LeftHandSide_Parenthesized :: T_Range -> T_LeftHandSide -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Parenthesized arg_range_ arg_lefthandside_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIname _lefthandsideIself) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _self = rule201 _lefthandsideIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule202 _self + _lhsOname :: Name + _lhsOname = rule203 _lefthandsideIname + __result_ = T_LeftHandSide_vOut82 _lhsOname _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule201 #-} + rule201 = \ ((_lefthandsideIself) :: LeftHandSide) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Parenthesized _rangeIself _lefthandsideIself _patternsIself + {-# INLINE rule202 #-} + rule202 = \ _self -> + _self + {-# INLINE rule203 #-} + rule203 = \ ((_lefthandsideIname) :: Name) -> + _lefthandsideIname + +-- Literal ----------------------------------------------------- +-- wrapper +data Inh_Literal = Inh_Literal { } +data Syn_Literal = Syn_Literal { self_Syn_Literal :: (Literal) } +{-# INLINABLE wrap_Literal #-} +wrap_Literal :: T_Literal -> Inh_Literal -> (Syn_Literal ) +wrap_Literal (T_Literal act) (Inh_Literal ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Literal_vIn85 + (T_Literal_vOut85 _lhsOself) <- return (inv_Literal_s86 sem arg) + return (Syn_Literal _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Literal #-} +sem_Literal :: Literal -> T_Literal +sem_Literal ( Literal_Int range_ value_ ) = sem_Literal_Int ( sem_Range range_ ) value_ +sem_Literal ( Literal_Char range_ value_ ) = sem_Literal_Char ( sem_Range range_ ) value_ +sem_Literal ( Literal_Float range_ value_ ) = sem_Literal_Float ( sem_Range range_ ) value_ +sem_Literal ( Literal_String range_ value_ ) = sem_Literal_String ( sem_Range range_ ) value_ + +-- semantic domain +newtype T_Literal = T_Literal { + attach_T_Literal :: Identity (T_Literal_s86 ) + } +newtype T_Literal_s86 = C_Literal_s86 { + inv_Literal_s86 :: (T_Literal_v85 ) + } +data T_Literal_s87 = C_Literal_s87 +type T_Literal_v85 = (T_Literal_vIn85 ) -> (T_Literal_vOut85 ) +data T_Literal_vIn85 = T_Literal_vIn85 +data T_Literal_vOut85 = T_Literal_vOut85 (Literal) +{-# NOINLINE sem_Literal_Int #-} +sem_Literal_Int :: T_Range -> (String) -> T_Literal +sem_Literal_Int arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule204 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule205 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule204 #-} + rule204 = \ ((_rangeIself) :: Range) value_ -> + Literal_Int _rangeIself value_ + {-# INLINE rule205 #-} + rule205 = \ _self -> + _self +{-# NOINLINE sem_Literal_Char #-} +sem_Literal_Char :: T_Range -> (String) -> T_Literal +sem_Literal_Char arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule206 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule207 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule206 #-} + rule206 = \ ((_rangeIself) :: Range) value_ -> + Literal_Char _rangeIself value_ + {-# INLINE rule207 #-} + rule207 = \ _self -> + _self +{-# NOINLINE sem_Literal_Float #-} +sem_Literal_Float :: T_Range -> (String) -> T_Literal +sem_Literal_Float arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule208 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule209 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule208 #-} + rule208 = \ ((_rangeIself) :: Range) value_ -> + Literal_Float _rangeIself value_ + {-# INLINE rule209 #-} + rule209 = \ _self -> + _self +{-# NOINLINE sem_Literal_String #-} +sem_Literal_String :: T_Range -> (String) -> T_Literal +sem_Literal_String arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule210 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule211 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule210 #-} + rule210 = \ ((_rangeIself) :: Range) value_ -> + Literal_String _rangeIself value_ + {-# INLINE rule211 #-} + rule211 = \ _self -> + _self + +-- MaybeDeclarations ------------------------------------------- +-- wrapper +data Inh_MaybeDeclarations = Inh_MaybeDeclarations { } +data Syn_MaybeDeclarations = Syn_MaybeDeclarations { self_Syn_MaybeDeclarations :: (MaybeDeclarations) } +{-# INLINABLE wrap_MaybeDeclarations #-} +wrap_MaybeDeclarations :: T_MaybeDeclarations -> Inh_MaybeDeclarations -> (Syn_MaybeDeclarations ) +wrap_MaybeDeclarations (T_MaybeDeclarations act) (Inh_MaybeDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeDeclarations_vIn88 + (T_MaybeDeclarations_vOut88 _lhsOself) <- return (inv_MaybeDeclarations_s89 sem arg) + return (Syn_MaybeDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeDeclarations #-} +sem_MaybeDeclarations :: MaybeDeclarations -> T_MaybeDeclarations +sem_MaybeDeclarations ( MaybeDeclarations_Nothing ) = sem_MaybeDeclarations_Nothing +sem_MaybeDeclarations ( MaybeDeclarations_Just declarations_ ) = sem_MaybeDeclarations_Just ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_MaybeDeclarations = T_MaybeDeclarations { + attach_T_MaybeDeclarations :: Identity (T_MaybeDeclarations_s89 ) + } +newtype T_MaybeDeclarations_s89 = C_MaybeDeclarations_s89 { + inv_MaybeDeclarations_s89 :: (T_MaybeDeclarations_v88 ) + } +data T_MaybeDeclarations_s90 = C_MaybeDeclarations_s90 +type T_MaybeDeclarations_v88 = (T_MaybeDeclarations_vIn88 ) -> (T_MaybeDeclarations_vOut88 ) +data T_MaybeDeclarations_vIn88 = T_MaybeDeclarations_vIn88 +data T_MaybeDeclarations_vOut88 = T_MaybeDeclarations_vOut88 (MaybeDeclarations) +{-# NOINLINE sem_MaybeDeclarations_Nothing #-} +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 ) -> ( let + _self = rule212 () + _lhsOself :: MaybeDeclarations + _lhsOself = rule213 _self + __result_ = T_MaybeDeclarations_vOut88 _lhsOself + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule212 #-} + rule212 = \ (_ :: ()) -> + MaybeDeclarations_Nothing + {-# INLINE rule213 #-} + rule213 = \ _self -> + _self +{-# NOINLINE sem_MaybeDeclarations_Just #-} +sem_MaybeDeclarations_Just :: T_Declarations -> T_MaybeDeclarations +sem_MaybeDeclarations_Just arg_declarations_ = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 ) -> ( let + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Declarations_vOut31 _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _self = rule214 _declarationsIself + _lhsOself :: MaybeDeclarations + _lhsOself = rule215 _self + __result_ = T_MaybeDeclarations_vOut88 _lhsOself + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule214 #-} + rule214 = \ ((_declarationsIself) :: Declarations) -> + MaybeDeclarations_Just _declarationsIself + {-# INLINE rule215 #-} + rule215 = \ _self -> + _self + +-- MaybeExports ------------------------------------------------ +-- wrapper +data Inh_MaybeExports = Inh_MaybeExports { } +data Syn_MaybeExports = Syn_MaybeExports { self_Syn_MaybeExports :: (MaybeExports) } +{-# INLINABLE wrap_MaybeExports #-} +wrap_MaybeExports :: T_MaybeExports -> Inh_MaybeExports -> (Syn_MaybeExports ) +wrap_MaybeExports (T_MaybeExports act) (Inh_MaybeExports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExports_vIn91 + (T_MaybeExports_vOut91 _lhsOself) <- return (inv_MaybeExports_s92 sem arg) + return (Syn_MaybeExports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExports #-} +sem_MaybeExports :: MaybeExports -> T_MaybeExports +sem_MaybeExports ( MaybeExports_Nothing ) = sem_MaybeExports_Nothing +sem_MaybeExports ( MaybeExports_Just exports_ ) = sem_MaybeExports_Just ( sem_Exports exports_ ) + +-- semantic domain +newtype T_MaybeExports = T_MaybeExports { + attach_T_MaybeExports :: Identity (T_MaybeExports_s92 ) + } +newtype T_MaybeExports_s92 = C_MaybeExports_s92 { + inv_MaybeExports_s92 :: (T_MaybeExports_v91 ) + } +data T_MaybeExports_s93 = C_MaybeExports_s93 +type T_MaybeExports_v91 = (T_MaybeExports_vIn91 ) -> (T_MaybeExports_vOut91 ) +data T_MaybeExports_vIn91 = T_MaybeExports_vIn91 +data T_MaybeExports_vOut91 = T_MaybeExports_vOut91 (MaybeExports) +{-# NOINLINE sem_MaybeExports_Nothing #-} +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _self = rule216 () + _lhsOself :: MaybeExports + _lhsOself = rule217 _self + __result_ = T_MaybeExports_vOut91 _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule216 #-} + rule216 = \ (_ :: ()) -> + MaybeExports_Nothing + {-# INLINE rule217 #-} + rule217 = \ _self -> + _self +{-# NOINLINE sem_MaybeExports_Just #-} +sem_MaybeExports_Just :: T_Exports -> T_MaybeExports +sem_MaybeExports_Just arg_exports_ = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _exportsX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_exports_)) + (T_Exports_vOut37 _exportsIself) = inv_Exports_s38 _exportsX38 (T_Exports_vIn37 ) + _self = rule218 _exportsIself + _lhsOself :: MaybeExports + _lhsOself = rule219 _self + __result_ = T_MaybeExports_vOut91 _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule218 #-} + rule218 = \ ((_exportsIself) :: Exports) -> + MaybeExports_Just _exportsIself + {-# INLINE rule219 #-} + rule219 = \ _self -> + _self + +-- MaybeExpression --------------------------------------------- +-- wrapper +data Inh_MaybeExpression = Inh_MaybeExpression { } +data Syn_MaybeExpression = Syn_MaybeExpression { self_Syn_MaybeExpression :: (MaybeExpression) } +{-# INLINABLE wrap_MaybeExpression #-} +wrap_MaybeExpression :: T_MaybeExpression -> Inh_MaybeExpression -> (Syn_MaybeExpression ) +wrap_MaybeExpression (T_MaybeExpression act) (Inh_MaybeExpression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExpression_vIn94 + (T_MaybeExpression_vOut94 _lhsOself) <- return (inv_MaybeExpression_s95 sem arg) + return (Syn_MaybeExpression _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExpression #-} +sem_MaybeExpression :: MaybeExpression -> T_MaybeExpression +sem_MaybeExpression ( MaybeExpression_Nothing ) = sem_MaybeExpression_Nothing +sem_MaybeExpression ( MaybeExpression_Just expression_ ) = sem_MaybeExpression_Just ( sem_Expression expression_ ) + +-- semantic domain +newtype T_MaybeExpression = T_MaybeExpression { + attach_T_MaybeExpression :: Identity (T_MaybeExpression_s95 ) + } +newtype T_MaybeExpression_s95 = C_MaybeExpression_s95 { + inv_MaybeExpression_s95 :: (T_MaybeExpression_v94 ) + } +data T_MaybeExpression_s96 = C_MaybeExpression_s96 +type T_MaybeExpression_v94 = (T_MaybeExpression_vIn94 ) -> (T_MaybeExpression_vOut94 ) +data T_MaybeExpression_vIn94 = T_MaybeExpression_vIn94 +data T_MaybeExpression_vOut94 = T_MaybeExpression_vOut94 (MaybeExpression) +{-# NOINLINE sem_MaybeExpression_Nothing #-} +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 ) -> ( let + _self = rule220 () + _lhsOself :: MaybeExpression + _lhsOself = rule221 _self + __result_ = T_MaybeExpression_vOut94 _lhsOself + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule220 #-} + rule220 = \ (_ :: ()) -> + MaybeExpression_Nothing + {-# INLINE rule221 #-} + rule221 = \ _self -> + _self +{-# NOINLINE sem_MaybeExpression_Just #-} +sem_MaybeExpression_Just :: T_Expression -> T_MaybeExpression +sem_MaybeExpression_Just arg_expression_ = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 ) -> ( let + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule222 _expressionIself + _lhsOself :: MaybeExpression + _lhsOself = rule223 _self + __result_ = T_MaybeExpression_vOut94 _lhsOself + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule222 #-} + rule222 = \ ((_expressionIself) :: Expression) -> + MaybeExpression_Just _expressionIself + {-# INLINE rule223 #-} + rule223 = \ _self -> + _self + +-- MaybeImportSpecification ------------------------------------ +-- wrapper +data Inh_MaybeImportSpecification = Inh_MaybeImportSpecification { } +data Syn_MaybeImportSpecification = Syn_MaybeImportSpecification { imps_Syn_MaybeImportSpecification :: ([Id]), self_Syn_MaybeImportSpecification :: (MaybeImportSpecification) } +{-# INLINABLE wrap_MaybeImportSpecification #-} +wrap_MaybeImportSpecification :: T_MaybeImportSpecification -> Inh_MaybeImportSpecification -> (Syn_MaybeImportSpecification ) +wrap_MaybeImportSpecification (T_MaybeImportSpecification act) (Inh_MaybeImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeImportSpecification_vIn97 + (T_MaybeImportSpecification_vOut97 _lhsOimps _lhsOself) <- return (inv_MaybeImportSpecification_s98 sem arg) + return (Syn_MaybeImportSpecification _lhsOimps _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeImportSpecification #-} +sem_MaybeImportSpecification :: MaybeImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification ( MaybeImportSpecification_Nothing ) = sem_MaybeImportSpecification_Nothing +sem_MaybeImportSpecification ( MaybeImportSpecification_Just importspecification_ ) = sem_MaybeImportSpecification_Just ( sem_ImportSpecification importspecification_ ) + +-- semantic domain +newtype T_MaybeImportSpecification = T_MaybeImportSpecification { + attach_T_MaybeImportSpecification :: Identity (T_MaybeImportSpecification_s98 ) + } +newtype T_MaybeImportSpecification_s98 = C_MaybeImportSpecification_s98 { + inv_MaybeImportSpecification_s98 :: (T_MaybeImportSpecification_v97 ) + } +data T_MaybeImportSpecification_s99 = C_MaybeImportSpecification_s99 +type T_MaybeImportSpecification_v97 = (T_MaybeImportSpecification_vIn97 ) -> (T_MaybeImportSpecification_vOut97 ) +data T_MaybeImportSpecification_vIn97 = T_MaybeImportSpecification_vIn97 +data T_MaybeImportSpecification_vOut97 = T_MaybeImportSpecification_vOut97 ([Id]) (MaybeImportSpecification) +{-# NOINLINE sem_MaybeImportSpecification_Nothing #-} +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _lhsOimps :: [Id] + _lhsOimps = rule224 () + _self = rule225 () + _lhsOself :: MaybeImportSpecification + _lhsOself = rule226 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOimps _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule224 #-} + rule224 = \ (_ :: ()) -> + [] + {-# INLINE rule225 #-} + rule225 = \ (_ :: ()) -> + MaybeImportSpecification_Nothing + {-# INLINE rule226 #-} + rule226 = \ _self -> + _self +{-# NOINLINE sem_MaybeImportSpecification_Just #-} +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification_Just arg_importspecification_ = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _importspecificationX77 = Control.Monad.Identity.runIdentity (attach_T_ImportSpecification (arg_importspecification_)) + (T_ImportSpecification_vOut76 _importspecificationIimps _importspecificationIself) = inv_ImportSpecification_s77 _importspecificationX77 (T_ImportSpecification_vIn76 ) + _lhsOimps :: [Id] + _lhsOimps = rule227 _importspecificationIimps + _self = rule228 _importspecificationIself + _lhsOself :: MaybeImportSpecification + _lhsOself = rule229 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOimps _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule227 #-} + rule227 = \ ((_importspecificationIimps) :: [Id]) -> + _importspecificationIimps + {-# INLINE rule228 #-} + rule228 = \ ((_importspecificationIself) :: ImportSpecification) -> + MaybeImportSpecification_Just _importspecificationIself + {-# INLINE rule229 #-} + rule229 = \ _self -> + _self + +-- MaybeInt ---------------------------------------------------- +-- wrapper +data Inh_MaybeInt = Inh_MaybeInt { } +data Syn_MaybeInt = Syn_MaybeInt { self_Syn_MaybeInt :: (MaybeInt) } +{-# INLINABLE wrap_MaybeInt #-} +wrap_MaybeInt :: T_MaybeInt -> Inh_MaybeInt -> (Syn_MaybeInt ) +wrap_MaybeInt (T_MaybeInt act) (Inh_MaybeInt ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeInt_vIn100 + (T_MaybeInt_vOut100 _lhsOself) <- return (inv_MaybeInt_s101 sem arg) + return (Syn_MaybeInt _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeInt #-} +sem_MaybeInt :: MaybeInt -> T_MaybeInt +sem_MaybeInt ( MaybeInt_Nothing ) = sem_MaybeInt_Nothing +sem_MaybeInt ( MaybeInt_Just int_ ) = sem_MaybeInt_Just int_ + +-- semantic domain +newtype T_MaybeInt = T_MaybeInt { + attach_T_MaybeInt :: Identity (T_MaybeInt_s101 ) + } +newtype T_MaybeInt_s101 = C_MaybeInt_s101 { + inv_MaybeInt_s101 :: (T_MaybeInt_v100 ) + } +data T_MaybeInt_s102 = C_MaybeInt_s102 +type T_MaybeInt_v100 = (T_MaybeInt_vIn100 ) -> (T_MaybeInt_vOut100 ) +data T_MaybeInt_vIn100 = T_MaybeInt_vIn100 +data T_MaybeInt_vOut100 = T_MaybeInt_vOut100 (MaybeInt) +{-# NOINLINE sem_MaybeInt_Nothing #-} +sem_MaybeInt_Nothing :: T_MaybeInt +sem_MaybeInt_Nothing = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule230 () + _lhsOself :: MaybeInt + _lhsOself = rule231 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule230 #-} + rule230 = \ (_ :: ()) -> + MaybeInt_Nothing + {-# INLINE rule231 #-} + rule231 = \ _self -> + _self +{-# NOINLINE sem_MaybeInt_Just #-} +sem_MaybeInt_Just :: (Int) -> T_MaybeInt +sem_MaybeInt_Just arg_int_ = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule232 arg_int_ + _lhsOself :: MaybeInt + _lhsOself = rule233 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule232 #-} + rule232 = \ int_ -> + MaybeInt_Just int_ + {-# INLINE rule233 #-} + rule233 = \ _self -> + _self + +-- MaybeName --------------------------------------------------- +-- wrapper +data Inh_MaybeName = Inh_MaybeName { } +data Syn_MaybeName = Syn_MaybeName { isNothing_Syn_MaybeName :: (Bool), name_Syn_MaybeName :: ( Maybe Name ), self_Syn_MaybeName :: (MaybeName) } +{-# INLINABLE wrap_MaybeName #-} +wrap_MaybeName :: T_MaybeName -> Inh_MaybeName -> (Syn_MaybeName ) +wrap_MaybeName (T_MaybeName act) (Inh_MaybeName ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeName_vIn103 + (T_MaybeName_vOut103 _lhsOisNothing _lhsOname _lhsOself) <- return (inv_MaybeName_s104 sem arg) + return (Syn_MaybeName _lhsOisNothing _lhsOname _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeName #-} +sem_MaybeName :: MaybeName -> T_MaybeName +sem_MaybeName ( MaybeName_Nothing ) = sem_MaybeName_Nothing +sem_MaybeName ( MaybeName_Just name_ ) = sem_MaybeName_Just ( sem_Name name_ ) + +-- semantic domain +newtype T_MaybeName = T_MaybeName { + attach_T_MaybeName :: Identity (T_MaybeName_s104 ) + } +newtype T_MaybeName_s104 = C_MaybeName_s104 { + inv_MaybeName_s104 :: (T_MaybeName_v103 ) + } +data T_MaybeName_s105 = C_MaybeName_s105 +type T_MaybeName_v103 = (T_MaybeName_vIn103 ) -> (T_MaybeName_vOut103 ) +data T_MaybeName_vIn103 = T_MaybeName_vIn103 +data T_MaybeName_vOut103 = T_MaybeName_vOut103 (Bool) ( Maybe Name ) (MaybeName) +{-# NOINLINE sem_MaybeName_Nothing #-} +sem_MaybeName_Nothing :: T_MaybeName +sem_MaybeName_Nothing = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _lhsOisNothing :: Bool + _lhsOisNothing = rule234 () + _lhsOname :: Maybe Name + _lhsOname = rule235 () + _self = rule236 () + _lhsOself :: MaybeName + _lhsOself = rule237 _self + __result_ = T_MaybeName_vOut103 _lhsOisNothing _lhsOname _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule234 #-} + rule234 = \ (_ :: ()) -> + True + {-# INLINE rule235 #-} + rule235 = \ (_ :: ()) -> + Nothing + {-# INLINE rule236 #-} + rule236 = \ (_ :: ()) -> + MaybeName_Nothing + {-# INLINE rule237 #-} + rule237 = \ _self -> + _self +{-# NOINLINE sem_MaybeName_Just #-} +sem_MaybeName_Just :: T_Name -> T_MaybeName +sem_MaybeName_Just arg_name_ = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOisNothing :: Bool + _lhsOisNothing = rule238 () + _lhsOname :: Maybe Name + _lhsOname = rule239 _nameIself + _self = rule240 _nameIself + _lhsOself :: MaybeName + _lhsOself = rule241 _self + __result_ = T_MaybeName_vOut103 _lhsOisNothing _lhsOname _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule238 #-} + rule238 = \ (_ :: ()) -> + False + {-# INLINE rule239 #-} + rule239 = \ ((_nameIself) :: Name) -> + Just _nameIself + {-# INLINE rule240 #-} + rule240 = \ ((_nameIself) :: Name) -> + MaybeName_Just _nameIself + {-# INLINE rule241 #-} + rule241 = \ _self -> + _self + +-- MaybeNames -------------------------------------------------- +-- wrapper +data Inh_MaybeNames = Inh_MaybeNames { } +data Syn_MaybeNames = Syn_MaybeNames { names_Syn_MaybeNames :: ( Maybe [Name] ), self_Syn_MaybeNames :: (MaybeNames) } +{-# INLINABLE wrap_MaybeNames #-} +wrap_MaybeNames :: T_MaybeNames -> Inh_MaybeNames -> (Syn_MaybeNames ) +wrap_MaybeNames (T_MaybeNames act) (Inh_MaybeNames ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeNames_vIn106 + (T_MaybeNames_vOut106 _lhsOnames _lhsOself) <- return (inv_MaybeNames_s107 sem arg) + return (Syn_MaybeNames _lhsOnames _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeNames #-} +sem_MaybeNames :: MaybeNames -> T_MaybeNames +sem_MaybeNames ( MaybeNames_Nothing ) = sem_MaybeNames_Nothing +sem_MaybeNames ( MaybeNames_Just names_ ) = sem_MaybeNames_Just ( sem_Names names_ ) + +-- semantic domain +newtype T_MaybeNames = T_MaybeNames { + attach_T_MaybeNames :: Identity (T_MaybeNames_s107 ) + } +newtype T_MaybeNames_s107 = C_MaybeNames_s107 { + inv_MaybeNames_s107 :: (T_MaybeNames_v106 ) + } +data T_MaybeNames_s108 = C_MaybeNames_s108 +type T_MaybeNames_v106 = (T_MaybeNames_vIn106 ) -> (T_MaybeNames_vOut106 ) +data T_MaybeNames_vIn106 = T_MaybeNames_vIn106 +data T_MaybeNames_vOut106 = T_MaybeNames_vOut106 ( Maybe [Name] ) (MaybeNames) +{-# NOINLINE sem_MaybeNames_Nothing #-} +sem_MaybeNames_Nothing :: T_MaybeNames +sem_MaybeNames_Nothing = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _lhsOnames :: Maybe [Name] + _lhsOnames = rule242 () + _self = rule243 () + _lhsOself :: MaybeNames + _lhsOself = rule244 _self + __result_ = T_MaybeNames_vOut106 _lhsOnames _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule242 #-} + rule242 = \ (_ :: ()) -> + Nothing + {-# INLINE rule243 #-} + rule243 = \ (_ :: ()) -> + MaybeNames_Nothing + {-# INLINE rule244 #-} + rule244 = \ _self -> + _self +{-# NOINLINE sem_MaybeNames_Just #-} +sem_MaybeNames_Just :: T_Names -> T_MaybeNames +sem_MaybeNames_Just arg_names_ = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + (T_Names_vOut115 _namesInames _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + _lhsOnames :: Maybe [Name] + _lhsOnames = rule245 _namesInames + _self = rule246 _namesIself + _lhsOself :: MaybeNames + _lhsOself = rule247 _self + __result_ = T_MaybeNames_vOut106 _lhsOnames _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule245 #-} + rule245 = \ ((_namesInames) :: [Name]) -> + Just _namesInames + {-# INLINE rule246 #-} + rule246 = \ ((_namesIself) :: Names) -> + MaybeNames_Just _namesIself + {-# INLINE rule247 #-} + rule247 = \ _self -> + _self + +-- Module ------------------------------------------------------ +-- wrapper +data Inh_Module = Inh_Module { } +data Syn_Module = Syn_Module { coreImportDecls_Syn_Module :: ( [(Core.CoreDecl,[Id])] ), self_Syn_Module :: (Module) } +{-# INLINABLE wrap_Module #-} +wrap_Module :: T_Module -> Inh_Module -> (Syn_Module ) +wrap_Module (T_Module act) (Inh_Module ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Module_vIn109 + (T_Module_vOut109 _lhsOcoreImportDecls _lhsOself) <- return (inv_Module_s110 sem arg) + return (Syn_Module _lhsOcoreImportDecls _lhsOself) + ) + +-- cata +{-# INLINE sem_Module #-} +sem_Module :: Module -> T_Module +sem_Module ( Module_Module range_ name_ exports_ body_ ) = sem_Module_Module ( sem_Range range_ ) ( sem_MaybeName name_ ) ( sem_MaybeExports exports_ ) ( sem_Body body_ ) + +-- semantic domain +newtype T_Module = T_Module { + attach_T_Module :: Identity (T_Module_s110 ) + } +newtype T_Module_s110 = C_Module_s110 { + inv_Module_s110 :: (T_Module_v109 ) + } +data T_Module_s111 = C_Module_s111 +type T_Module_v109 = (T_Module_vIn109 ) -> (T_Module_vOut109 ) +data T_Module_vIn109 = T_Module_vIn109 +data T_Module_vOut109 = T_Module_vOut109 ( [(Core.CoreDecl,[Id])] ) (Module) +{-# NOINLINE sem_Module_Module #-} +sem_Module_Module :: T_Range -> T_MaybeName -> T_MaybeExports -> T_Body -> T_Module +sem_Module_Module arg_range_ arg_name_ arg_exports_ arg_body_ = T_Module (return st110) where + {-# NOINLINE st110 #-} + st110 = let + v109 :: T_Module_v109 + v109 = \ (T_Module_vIn109 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_name_)) + _exportsX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeExports (arg_exports_)) + _bodyX14 = Control.Monad.Identity.runIdentity (attach_T_Body (arg_body_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeName_vOut103 _nameIisNothing _nameIname _nameIself) = inv_MaybeName_s104 _nameX104 (T_MaybeName_vIn103 ) + (T_MaybeExports_vOut91 _exportsIself) = inv_MaybeExports_s92 _exportsX92 (T_MaybeExports_vIn91 ) + (T_Body_vOut13 _bodyIcoreImportDecls _bodyIself) = inv_Body_s14 _bodyX14 (T_Body_vIn13 ) + _self = rule248 _bodyIself _exportsIself _nameIself _rangeIself + _lhsOself :: Module + _lhsOself = rule249 _self + _lhsOcoreImportDecls :: [(Core.CoreDecl,[Id])] + _lhsOcoreImportDecls = rule250 _bodyIcoreImportDecls + __result_ = T_Module_vOut109 _lhsOcoreImportDecls _lhsOself + in __result_ ) + in C_Module_s110 v109 + {-# INLINE rule248 #-} + rule248 = \ ((_bodyIself) :: Body) ((_exportsIself) :: MaybeExports) ((_nameIself) :: MaybeName) ((_rangeIself) :: Range) -> + Module_Module _rangeIself _nameIself _exportsIself _bodyIself + {-# INLINE rule249 #-} + rule249 = \ _self -> + _self + {-# INLINE rule250 #-} + rule250 = \ ((_bodyIcoreImportDecls) :: [(Core.CoreDecl,[Id])] ) -> + _bodyIcoreImportDecls + +-- Name -------------------------------------------------------- +-- wrapper +data Inh_Name = Inh_Name { } +data Syn_Name = Syn_Name { self_Syn_Name :: (Name) } +{-# INLINABLE wrap_Name #-} +wrap_Name :: T_Name -> Inh_Name -> (Syn_Name ) +wrap_Name (T_Name act) (Inh_Name ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Name_vIn112 + (T_Name_vOut112 _lhsOself) <- return (inv_Name_s113 sem arg) + return (Syn_Name _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Name #-} +sem_Name :: Name -> T_Name +sem_Name ( Name_Identifier range_ module_ name_ ) = sem_Name_Identifier ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Operator range_ module_ name_ ) = sem_Name_Operator ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Special range_ module_ name_ ) = sem_Name_Special ( sem_Range range_ ) ( sem_Strings module_ ) name_ + +-- semantic domain +newtype T_Name = T_Name { + attach_T_Name :: Identity (T_Name_s113 ) + } +newtype T_Name_s113 = C_Name_s113 { + inv_Name_s113 :: (T_Name_v112 ) + } +data T_Name_s114 = C_Name_s114 +type T_Name_v112 = (T_Name_vIn112 ) -> (T_Name_vOut112 ) +data T_Name_vIn112 = T_Name_vIn112 +data T_Name_vOut112 = T_Name_vOut112 (Name) +{-# NOINLINE sem_Name_Identifier #-} +sem_Name_Identifier :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Identifier arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule251 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule252 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule251 #-} + rule251 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Identifier _rangeIself _moduleIself name_ + {-# INLINE rule252 #-} + rule252 = \ _self -> + _self +{-# NOINLINE sem_Name_Operator #-} +sem_Name_Operator :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Operator arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule253 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule254 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule253 #-} + rule253 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Operator _rangeIself _moduleIself name_ + {-# INLINE rule254 #-} + rule254 = \ _self -> + _self +{-# NOINLINE sem_Name_Special #-} +sem_Name_Special :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Special arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule255 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule256 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule255 #-} + rule255 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Special _rangeIself _moduleIself name_ + {-# INLINE rule256 #-} + rule256 = \ _self -> + _self + +-- Names ------------------------------------------------------- +-- wrapper +data Inh_Names = Inh_Names { } +data Syn_Names = Syn_Names { names_Syn_Names :: ([Name]), self_Syn_Names :: (Names) } +{-# INLINABLE wrap_Names #-} +wrap_Names :: T_Names -> Inh_Names -> (Syn_Names ) +wrap_Names (T_Names act) (Inh_Names ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Names_vIn115 + (T_Names_vOut115 _lhsOnames _lhsOself) <- return (inv_Names_s116 sem arg) + return (Syn_Names _lhsOnames _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Names #-} +sem_Names :: Names -> T_Names +sem_Names list = Prelude.foldr sem_Names_Cons sem_Names_Nil (Prelude.map sem_Name list) + +-- semantic domain +newtype T_Names = T_Names { + attach_T_Names :: Identity (T_Names_s116 ) + } +newtype T_Names_s116 = C_Names_s116 { + inv_Names_s116 :: (T_Names_v115 ) + } +data T_Names_s117 = C_Names_s117 +type T_Names_v115 = (T_Names_vIn115 ) -> (T_Names_vOut115 ) +data T_Names_vIn115 = T_Names_vIn115 +data T_Names_vOut115 = T_Names_vOut115 ([Name]) (Names) +{-# NOINLINE sem_Names_Cons #-} +sem_Names_Cons :: T_Name -> T_Names -> T_Names +sem_Names_Cons arg_hd_ arg_tl_ = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _hdX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_hd_)) + _tlX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_tl_)) + (T_Name_vOut112 _hdIself) = inv_Name_s113 _hdX113 (T_Name_vIn112 ) + (T_Names_vOut115 _tlInames _tlIself) = inv_Names_s116 _tlX116 (T_Names_vIn115 ) + _lhsOnames :: [Name] + _lhsOnames = rule257 _hdIself _tlInames + _self = rule258 _hdIself _tlIself + _lhsOself :: Names + _lhsOself = rule259 _self + __result_ = T_Names_vOut115 _lhsOnames _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule257 #-} + rule257 = \ ((_hdIself) :: Name) ((_tlInames) :: [Name]) -> + _hdIself : _tlInames + {-# INLINE rule258 #-} + rule258 = \ ((_hdIself) :: Name) ((_tlIself) :: Names) -> + (:) _hdIself _tlIself + {-# INLINE rule259 #-} + rule259 = \ _self -> + _self +{-# NOINLINE sem_Names_Nil #-} +sem_Names_Nil :: T_Names +sem_Names_Nil = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _lhsOnames :: [Name] + _lhsOnames = rule260 () + _self = rule261 () + _lhsOself :: Names + _lhsOself = rule262 _self + __result_ = T_Names_vOut115 _lhsOnames _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule260 #-} + rule260 = \ (_ :: ()) -> + [] + {-# INLINE rule261 #-} + rule261 = \ (_ :: ()) -> + [] + {-# INLINE rule262 #-} + rule262 = \ _self -> + _self + +-- Pattern ----------------------------------------------------- +-- wrapper +data Inh_Pattern = Inh_Pattern { } +data Syn_Pattern = Syn_Pattern { self_Syn_Pattern :: (Pattern) } +{-# INLINABLE wrap_Pattern #-} +wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) +wrap_Pattern (T_Pattern act) (Inh_Pattern ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Pattern_vIn118 + (T_Pattern_vOut118 _lhsOself) <- return (inv_Pattern_s119 sem arg) + return (Syn_Pattern _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Pattern #-} +sem_Pattern :: Pattern -> T_Pattern +sem_Pattern ( Pattern_Hole range_ id_ ) = sem_Pattern_Hole ( sem_Range range_ ) id_ +sem_Pattern ( Pattern_Literal range_ literal_ ) = sem_Pattern_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_Variable range_ name_ ) = sem_Pattern_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Pattern ( Pattern_Constructor range_ name_ patterns_ ) = sem_Pattern_Constructor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Parenthesized range_ pattern_ ) = sem_Pattern_Parenthesized ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ ) = sem_Pattern_InfixConstructor ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name constructorOperator_ ) ( sem_Pattern rightPattern_ ) +sem_Pattern ( Pattern_List range_ patterns_ ) = sem_Pattern_List ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Tuple range_ patterns_ ) = sem_Pattern_Tuple ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Record range_ name_ recordPatternBindings_ ) = sem_Pattern_Record ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordPatternBindings recordPatternBindings_ ) +sem_Pattern ( Pattern_Negate range_ literal_ ) = sem_Pattern_Negate ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_As range_ name_ pattern_ ) = sem_Pattern_As ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Wildcard range_ ) = sem_Pattern_Wildcard ( sem_Range range_ ) +sem_Pattern ( Pattern_Irrefutable range_ pattern_ ) = sem_Pattern_Irrefutable ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Successor range_ name_ literal_ ) = sem_Pattern_Successor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_NegateFloat range_ literal_ ) = sem_Pattern_NegateFloat ( sem_Range range_ ) ( sem_Literal literal_ ) + +-- semantic domain +newtype T_Pattern = T_Pattern { + attach_T_Pattern :: Identity (T_Pattern_s119 ) + } +newtype T_Pattern_s119 = C_Pattern_s119 { + inv_Pattern_s119 :: (T_Pattern_v118 ) + } +data T_Pattern_s120 = C_Pattern_s120 +type T_Pattern_v118 = (T_Pattern_vIn118 ) -> (T_Pattern_vOut118 ) +data T_Pattern_vIn118 = T_Pattern_vIn118 +data T_Pattern_vOut118 = T_Pattern_vOut118 (Pattern) +{-# NOINLINE sem_Pattern_Hole #-} +sem_Pattern_Hole :: T_Range -> (Integer) -> T_Pattern +sem_Pattern_Hole arg_range_ arg_id_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule263 _rangeIself arg_id_ + _lhsOself :: Pattern + _lhsOself = rule264 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule263 #-} + rule263 = \ ((_rangeIself) :: Range) id_ -> + Pattern_Hole _rangeIself id_ + {-# INLINE rule264 #-} + rule264 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Literal #-} +sem_Pattern_Literal :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Literal arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule265 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule266 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule265 #-} + rule265 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Literal _rangeIself _literalIself + {-# INLINE rule266 #-} + rule266 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Variable #-} +sem_Pattern_Variable :: T_Range -> T_Name -> T_Pattern +sem_Pattern_Variable arg_range_ arg_name_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule267 _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule268 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule267 #-} + rule267 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Variable _rangeIself _nameIself + {-# INLINE rule268 #-} + rule268 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Constructor #-} +sem_Pattern_Constructor :: T_Range -> T_Name -> T_Patterns -> T_Pattern +sem_Pattern_Constructor arg_range_ arg_name_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _self = rule269 _nameIself _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule270 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule269 #-} + rule269 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Constructor _rangeIself _nameIself _patternsIself + {-# INLINE rule270 #-} + rule270 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Parenthesized #-} +sem_Pattern_Parenthesized :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Parenthesized arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _self = rule271 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule272 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule271 #-} + rule271 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Parenthesized _rangeIself _patternIself + {-# INLINE rule272 #-} + rule272 = \ _self -> + _self +{-# NOINLINE sem_Pattern_InfixConstructor #-} +sem_Pattern_InfixConstructor :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_InfixConstructor arg_range_ arg_leftPattern_ arg_constructorOperator_ arg_rightPattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIself) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 ) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIself) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 ) + _self = rule273 _constructorOperatorIself _leftPatternIself _rangeIself _rightPatternIself + _lhsOself :: Pattern + _lhsOself = rule274 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule273 #-} + rule273 = \ ((_constructorOperatorIself) :: Name) ((_leftPatternIself) :: Pattern) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + Pattern_InfixConstructor _rangeIself _leftPatternIself _constructorOperatorIself _rightPatternIself + {-# INLINE rule274 #-} + rule274 = \ _self -> + _self +{-# NOINLINE sem_Pattern_List #-} +sem_Pattern_List :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_List arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _self = rule275 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule276 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule275 #-} + rule275 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_List _rangeIself _patternsIself + {-# INLINE rule276 #-} + rule276 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Tuple #-} +sem_Pattern_Tuple :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_Tuple arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _self = rule277 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule278 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule277 #-} + rule277 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Tuple _rangeIself _patternsIself + {-# INLINE rule278 #-} + rule278 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Record #-} +sem_Pattern_Record :: T_Range -> T_Name -> T_RecordPatternBindings -> T_Pattern +sem_Pattern_Record arg_range_ arg_name_ arg_recordPatternBindings_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordPatternBindingsX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_recordPatternBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordPatternBindings_vOut145 _recordPatternBindingsIself) = inv_RecordPatternBindings_s146 _recordPatternBindingsX146 (T_RecordPatternBindings_vIn145 ) + _self = rule279 _nameIself _rangeIself _recordPatternBindingsIself + _lhsOself :: Pattern + _lhsOself = rule280 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule279 #-} + rule279 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordPatternBindingsIself) :: RecordPatternBindings) -> + Pattern_Record _rangeIself _nameIself _recordPatternBindingsIself + {-# INLINE rule280 #-} + rule280 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Negate #-} +sem_Pattern_Negate :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Negate arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule281 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule282 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule281 #-} + rule281 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Negate _rangeIself _literalIself + {-# INLINE rule282 #-} + rule282 = \ _self -> + _self +{-# NOINLINE sem_Pattern_As #-} +sem_Pattern_As :: T_Range -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_As arg_range_ arg_name_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _self = rule283 _nameIself _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule284 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule283 #-} + rule283 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_As _rangeIself _nameIself _patternIself + {-# INLINE rule284 #-} + rule284 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Wildcard #-} +sem_Pattern_Wildcard :: T_Range -> T_Pattern +sem_Pattern_Wildcard arg_range_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule285 _rangeIself + _lhsOself :: Pattern + _lhsOself = rule286 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule285 #-} + rule285 = \ ((_rangeIself) :: Range) -> + Pattern_Wildcard _rangeIself + {-# INLINE rule286 #-} + rule286 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Irrefutable #-} +sem_Pattern_Irrefutable :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Irrefutable arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _self = rule287 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule288 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule287 #-} + rule287 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Irrefutable _rangeIself _patternIself + {-# INLINE rule288 #-} + rule288 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Successor #-} +sem_Pattern_Successor :: T_Range -> T_Name -> T_Literal -> T_Pattern +sem_Pattern_Successor arg_range_ arg_name_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule289 _literalIself _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule290 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule289 #-} + rule289 = \ ((_literalIself) :: Literal) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Successor _rangeIself _nameIself _literalIself + {-# INLINE rule290 #-} + rule290 = \ _self -> + _self +{-# NOINLINE sem_Pattern_NegateFloat #-} +sem_Pattern_NegateFloat :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_NegateFloat arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule291 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule292 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule291 #-} + rule291 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_NegateFloat _rangeIself _literalIself + {-# INLINE rule292 #-} + rule292 = \ _self -> + _self + +-- Patterns ---------------------------------------------------- +-- wrapper +data Inh_Patterns = Inh_Patterns { } +data Syn_Patterns = Syn_Patterns { self_Syn_Patterns :: (Patterns) } +{-# INLINABLE wrap_Patterns #-} +wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) +wrap_Patterns (T_Patterns act) (Inh_Patterns ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Patterns_vIn121 + (T_Patterns_vOut121 _lhsOself) <- return (inv_Patterns_s122 sem arg) + return (Syn_Patterns _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Patterns #-} +sem_Patterns :: Patterns -> T_Patterns +sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) + +-- semantic domain +newtype T_Patterns = T_Patterns { + attach_T_Patterns :: Identity (T_Patterns_s122 ) + } +newtype T_Patterns_s122 = C_Patterns_s122 { + inv_Patterns_s122 :: (T_Patterns_v121 ) + } +data T_Patterns_s123 = C_Patterns_s123 +type T_Patterns_v121 = (T_Patterns_vIn121 ) -> (T_Patterns_vOut121 ) +data T_Patterns_vIn121 = T_Patterns_vIn121 +data T_Patterns_vOut121 = T_Patterns_vOut121 (Patterns) +{-# NOINLINE sem_Patterns_Cons #-} +sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns +sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 ) -> ( let + _hdX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) + _tlX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) + (T_Pattern_vOut118 _hdIself) = inv_Pattern_s119 _hdX119 (T_Pattern_vIn118 ) + (T_Patterns_vOut121 _tlIself) = inv_Patterns_s122 _tlX122 (T_Patterns_vIn121 ) + _self = rule293 _hdIself _tlIself + _lhsOself :: Patterns + _lhsOself = rule294 _self + __result_ = T_Patterns_vOut121 _lhsOself + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule293 #-} + rule293 = \ ((_hdIself) :: Pattern) ((_tlIself) :: Patterns) -> + (:) _hdIself _tlIself + {-# INLINE rule294 #-} + rule294 = \ _self -> + _self +{-# NOINLINE sem_Patterns_Nil #-} +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 ) -> ( let + _self = rule295 () + _lhsOself :: Patterns + _lhsOself = rule296 _self + __result_ = T_Patterns_vOut121 _lhsOself + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule295 #-} + rule295 = \ (_ :: ()) -> + [] + {-# INLINE rule296 #-} + rule296 = \ _self -> + _self + +-- Position ---------------------------------------------------- +-- wrapper +data Inh_Position = Inh_Position { } +data Syn_Position = Syn_Position { self_Syn_Position :: (Position) } +{-# INLINABLE wrap_Position #-} +wrap_Position :: T_Position -> Inh_Position -> (Syn_Position ) +wrap_Position (T_Position act) (Inh_Position ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Position_vIn124 + (T_Position_vOut124 _lhsOself) <- return (inv_Position_s125 sem arg) + return (Syn_Position _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Position #-} +sem_Position :: Position -> T_Position +sem_Position ( Position_Position filename_ line_ column_ ) = sem_Position_Position filename_ line_ column_ +sem_Position ( Position_Unknown ) = sem_Position_Unknown + +-- semantic domain +newtype T_Position = T_Position { + attach_T_Position :: Identity (T_Position_s125 ) + } +newtype T_Position_s125 = C_Position_s125 { + inv_Position_s125 :: (T_Position_v124 ) + } +data T_Position_s126 = C_Position_s126 +type T_Position_v124 = (T_Position_vIn124 ) -> (T_Position_vOut124 ) +data T_Position_vIn124 = T_Position_vIn124 +data T_Position_vOut124 = T_Position_vOut124 (Position) +{-# NOINLINE sem_Position_Position #-} +sem_Position_Position :: (String) -> (Int) -> (Int) -> T_Position +sem_Position_Position arg_filename_ arg_line_ arg_column_ = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule297 arg_column_ arg_filename_ arg_line_ + _lhsOself :: Position + _lhsOself = rule298 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule297 #-} + rule297 = \ column_ filename_ line_ -> + Position_Position filename_ line_ column_ + {-# INLINE rule298 #-} + rule298 = \ _self -> + _self +{-# NOINLINE sem_Position_Unknown #-} +sem_Position_Unknown :: T_Position +sem_Position_Unknown = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule299 () + _lhsOself :: Position + _lhsOself = rule300 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule299 #-} + rule299 = \ (_ :: ()) -> + Position_Unknown + {-# INLINE rule300 #-} + rule300 = \ _self -> + _self + +-- Qualifier --------------------------------------------------- +-- wrapper +data Inh_Qualifier = Inh_Qualifier { } +data Syn_Qualifier = Syn_Qualifier { self_Syn_Qualifier :: (Qualifier) } +{-# INLINABLE wrap_Qualifier #-} +wrap_Qualifier :: T_Qualifier -> Inh_Qualifier -> (Syn_Qualifier ) +wrap_Qualifier (T_Qualifier act) (Inh_Qualifier ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifier_vIn127 + (T_Qualifier_vOut127 _lhsOself) <- return (inv_Qualifier_s128 sem arg) + return (Syn_Qualifier _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifier #-} +sem_Qualifier :: Qualifier -> T_Qualifier +sem_Qualifier ( Qualifier_Guard range_ guard_ ) = sem_Qualifier_Guard ( sem_Range range_ ) ( sem_Expression guard_ ) +sem_Qualifier ( Qualifier_Let range_ declarations_ ) = sem_Qualifier_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Qualifier ( Qualifier_Generator range_ pattern_ expression_ ) = sem_Qualifier_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Qualifier ( Qualifier_Empty range_ ) = sem_Qualifier_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Qualifier = T_Qualifier { + attach_T_Qualifier :: Identity (T_Qualifier_s128 ) + } +newtype T_Qualifier_s128 = C_Qualifier_s128 { + inv_Qualifier_s128 :: (T_Qualifier_v127 ) + } +data T_Qualifier_s129 = C_Qualifier_s129 +type T_Qualifier_v127 = (T_Qualifier_vIn127 ) -> (T_Qualifier_vOut127 ) +data T_Qualifier_vIn127 = T_Qualifier_vIn127 +data T_Qualifier_vOut127 = T_Qualifier_vOut127 (Qualifier) +{-# NOINLINE sem_Qualifier_Guard #-} +sem_Qualifier_Guard :: T_Range -> T_Expression -> T_Qualifier +sem_Qualifier_Guard arg_range_ arg_guard_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 ) + _self = rule301 _guardIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule302 _self + __result_ = T_Qualifier_vOut127 _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule301 #-} + rule301 = \ ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + Qualifier_Guard _rangeIself _guardIself + {-# INLINE rule302 #-} + rule302 = \ _self -> + _self +{-# NOINLINE sem_Qualifier_Let #-} +sem_Qualifier_Let :: T_Range -> T_Declarations -> T_Qualifier +sem_Qualifier_Let arg_range_ arg_declarations_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _self = rule303 _declarationsIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule304 _self + __result_ = T_Qualifier_vOut127 _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule303 #-} + rule303 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Qualifier_Let _rangeIself _declarationsIself + {-# INLINE rule304 #-} + rule304 = \ _self -> + _self +{-# NOINLINE sem_Qualifier_Generator #-} +sem_Qualifier_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Qualifier +sem_Qualifier_Generator arg_range_ arg_pattern_ arg_expression_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule305 _expressionIself _patternIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule306 _self + __result_ = T_Qualifier_vOut127 _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule305 #-} + rule305 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Qualifier_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule306 #-} + rule306 = \ _self -> + _self +{-# NOINLINE sem_Qualifier_Empty #-} +sem_Qualifier_Empty :: T_Range -> T_Qualifier +sem_Qualifier_Empty arg_range_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule307 _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule308 _self + __result_ = T_Qualifier_vOut127 _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule307 #-} + rule307 = \ ((_rangeIself) :: Range) -> + Qualifier_Empty _rangeIself + {-# INLINE rule308 #-} + rule308 = \ _self -> + _self + +-- Qualifiers -------------------------------------------------- +-- wrapper +data Inh_Qualifiers = Inh_Qualifiers { } +data Syn_Qualifiers = Syn_Qualifiers { self_Syn_Qualifiers :: (Qualifiers) } +{-# INLINABLE wrap_Qualifiers #-} +wrap_Qualifiers :: T_Qualifiers -> Inh_Qualifiers -> (Syn_Qualifiers ) +wrap_Qualifiers (T_Qualifiers act) (Inh_Qualifiers ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifiers_vIn130 + (T_Qualifiers_vOut130 _lhsOself) <- return (inv_Qualifiers_s131 sem arg) + return (Syn_Qualifiers _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifiers #-} +sem_Qualifiers :: Qualifiers -> T_Qualifiers +sem_Qualifiers list = Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list) + +-- semantic domain +newtype T_Qualifiers = T_Qualifiers { + attach_T_Qualifiers :: Identity (T_Qualifiers_s131 ) + } +newtype T_Qualifiers_s131 = C_Qualifiers_s131 { + inv_Qualifiers_s131 :: (T_Qualifiers_v130 ) + } +data T_Qualifiers_s132 = C_Qualifiers_s132 +type T_Qualifiers_v130 = (T_Qualifiers_vIn130 ) -> (T_Qualifiers_vOut130 ) +data T_Qualifiers_vIn130 = T_Qualifiers_vIn130 +data T_Qualifiers_vOut130 = T_Qualifiers_vOut130 (Qualifiers) +{-# NOINLINE sem_Qualifiers_Cons #-} +sem_Qualifiers_Cons :: T_Qualifier -> T_Qualifiers -> T_Qualifiers +sem_Qualifiers_Cons arg_hd_ arg_tl_ = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 ) -> ( let + _hdX128 = Control.Monad.Identity.runIdentity (attach_T_Qualifier (arg_hd_)) + _tlX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_tl_)) + (T_Qualifier_vOut127 _hdIself) = inv_Qualifier_s128 _hdX128 (T_Qualifier_vIn127 ) + (T_Qualifiers_vOut130 _tlIself) = inv_Qualifiers_s131 _tlX131 (T_Qualifiers_vIn130 ) + _self = rule309 _hdIself _tlIself + _lhsOself :: Qualifiers + _lhsOself = rule310 _self + __result_ = T_Qualifiers_vOut130 _lhsOself + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule309 #-} + rule309 = \ ((_hdIself) :: Qualifier) ((_tlIself) :: Qualifiers) -> + (:) _hdIself _tlIself + {-# INLINE rule310 #-} + rule310 = \ _self -> + _self +{-# NOINLINE sem_Qualifiers_Nil #-} +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 ) -> ( let + _self = rule311 () + _lhsOself :: Qualifiers + _lhsOself = rule312 _self + __result_ = T_Qualifiers_vOut130 _lhsOself + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule311 #-} + rule311 = \ (_ :: ()) -> + [] + {-# INLINE rule312 #-} + rule312 = \ _self -> + _self + +-- Range ------------------------------------------------------- +-- wrapper +data Inh_Range = Inh_Range { } +data Syn_Range = Syn_Range { self_Syn_Range :: (Range) } +{-# INLINABLE wrap_Range #-} +wrap_Range :: T_Range -> Inh_Range -> (Syn_Range ) +wrap_Range (T_Range act) (Inh_Range ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Range_vIn133 + (T_Range_vOut133 _lhsOself) <- return (inv_Range_s134 sem arg) + return (Syn_Range _lhsOself) + ) + +-- cata +{-# INLINE sem_Range #-} +sem_Range :: Range -> T_Range +sem_Range ( Range_Range start_ stop_ ) = sem_Range_Range ( sem_Position start_ ) ( sem_Position stop_ ) + +-- semantic domain +newtype T_Range = T_Range { + attach_T_Range :: Identity (T_Range_s134 ) + } +newtype T_Range_s134 = C_Range_s134 { + inv_Range_s134 :: (T_Range_v133 ) + } +data T_Range_s135 = C_Range_s135 +type T_Range_v133 = (T_Range_vIn133 ) -> (T_Range_vOut133 ) +data T_Range_vIn133 = T_Range_vIn133 +data T_Range_vOut133 = T_Range_vOut133 (Range) +{-# NOINLINE sem_Range_Range #-} +sem_Range_Range :: T_Position -> T_Position -> T_Range +sem_Range_Range arg_start_ arg_stop_ = T_Range (return st134) where + {-# NOINLINE st134 #-} + st134 = let + v133 :: T_Range_v133 + v133 = \ (T_Range_vIn133 ) -> ( let + _startX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_start_)) + _stopX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_stop_)) + (T_Position_vOut124 _startIself) = inv_Position_s125 _startX125 (T_Position_vIn124 ) + (T_Position_vOut124 _stopIself) = inv_Position_s125 _stopX125 (T_Position_vIn124 ) + _self = rule313 _startIself _stopIself + _lhsOself :: Range + _lhsOself = rule314 _self + __result_ = T_Range_vOut133 _lhsOself + in __result_ ) + in C_Range_s134 v133 + {-# INLINE rule313 #-} + rule313 = \ ((_startIself) :: Position) ((_stopIself) :: Position) -> + Range_Range _startIself _stopIself + {-# INLINE rule314 #-} + rule314 = \ _self -> + _self + +-- RecordExpressionBinding ------------------------------------- +-- wrapper +data Inh_RecordExpressionBinding = Inh_RecordExpressionBinding { } +data Syn_RecordExpressionBinding = Syn_RecordExpressionBinding { self_Syn_RecordExpressionBinding :: (RecordExpressionBinding) } +{-# INLINABLE wrap_RecordExpressionBinding #-} +wrap_RecordExpressionBinding :: T_RecordExpressionBinding -> Inh_RecordExpressionBinding -> (Syn_RecordExpressionBinding ) +wrap_RecordExpressionBinding (T_RecordExpressionBinding act) (Inh_RecordExpressionBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBinding_vIn136 + (T_RecordExpressionBinding_vOut136 _lhsOself) <- return (inv_RecordExpressionBinding_s137 sem arg) + return (Syn_RecordExpressionBinding _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBinding #-} +sem_RecordExpressionBinding :: RecordExpressionBinding -> T_RecordExpressionBinding +sem_RecordExpressionBinding ( RecordExpressionBinding_RecordExpressionBinding range_ name_ expression_ ) = sem_RecordExpressionBinding_RecordExpressionBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_RecordExpressionBinding = T_RecordExpressionBinding { + attach_T_RecordExpressionBinding :: Identity (T_RecordExpressionBinding_s137 ) + } +newtype T_RecordExpressionBinding_s137 = C_RecordExpressionBinding_s137 { + inv_RecordExpressionBinding_s137 :: (T_RecordExpressionBinding_v136 ) + } +data T_RecordExpressionBinding_s138 = C_RecordExpressionBinding_s138 +type T_RecordExpressionBinding_v136 = (T_RecordExpressionBinding_vIn136 ) -> (T_RecordExpressionBinding_vOut136 ) +data T_RecordExpressionBinding_vIn136 = T_RecordExpressionBinding_vIn136 +data T_RecordExpressionBinding_vOut136 = T_RecordExpressionBinding_vOut136 (RecordExpressionBinding) +{-# NOINLINE sem_RecordExpressionBinding_RecordExpressionBinding #-} +sem_RecordExpressionBinding_RecordExpressionBinding :: T_Range -> T_Name -> T_Expression -> T_RecordExpressionBinding +sem_RecordExpressionBinding_RecordExpressionBinding arg_range_ arg_name_ arg_expression_ = T_RecordExpressionBinding (return st137) where + {-# NOINLINE st137 #-} + st137 = let + v136 :: T_RecordExpressionBinding_v136 + v136 = \ (T_RecordExpressionBinding_vIn136 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule315 _expressionIself _nameIself _rangeIself + _lhsOself :: RecordExpressionBinding + _lhsOself = rule316 _self + __result_ = T_RecordExpressionBinding_vOut136 _lhsOself + in __result_ ) + in C_RecordExpressionBinding_s137 v136 + {-# INLINE rule315 #-} + rule315 = \ ((_expressionIself) :: Expression) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + RecordExpressionBinding_RecordExpressionBinding _rangeIself _nameIself _expressionIself + {-# INLINE rule316 #-} + rule316 = \ _self -> + _self + +-- RecordExpressionBindings ------------------------------------ +-- wrapper +data Inh_RecordExpressionBindings = Inh_RecordExpressionBindings { } +data Syn_RecordExpressionBindings = Syn_RecordExpressionBindings { self_Syn_RecordExpressionBindings :: (RecordExpressionBindings) } +{-# INLINABLE wrap_RecordExpressionBindings #-} +wrap_RecordExpressionBindings :: T_RecordExpressionBindings -> Inh_RecordExpressionBindings -> (Syn_RecordExpressionBindings ) +wrap_RecordExpressionBindings (T_RecordExpressionBindings act) (Inh_RecordExpressionBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBindings_vIn139 + (T_RecordExpressionBindings_vOut139 _lhsOself) <- return (inv_RecordExpressionBindings_s140 sem arg) + return (Syn_RecordExpressionBindings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBindings #-} +sem_RecordExpressionBindings :: RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings list = Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list) + +-- semantic domain +newtype T_RecordExpressionBindings = T_RecordExpressionBindings { + attach_T_RecordExpressionBindings :: Identity (T_RecordExpressionBindings_s140 ) + } +newtype T_RecordExpressionBindings_s140 = C_RecordExpressionBindings_s140 { + inv_RecordExpressionBindings_s140 :: (T_RecordExpressionBindings_v139 ) + } +data T_RecordExpressionBindings_s141 = C_RecordExpressionBindings_s141 +type T_RecordExpressionBindings_v139 = (T_RecordExpressionBindings_vIn139 ) -> (T_RecordExpressionBindings_vOut139 ) +data T_RecordExpressionBindings_vIn139 = T_RecordExpressionBindings_vIn139 +data T_RecordExpressionBindings_vOut139 = T_RecordExpressionBindings_vOut139 (RecordExpressionBindings) +{-# NOINLINE sem_RecordExpressionBindings_Cons #-} +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> T_RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons arg_hd_ arg_tl_ = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 ) -> ( let + _hdX137 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBinding (arg_hd_)) + _tlX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_tl_)) + (T_RecordExpressionBinding_vOut136 _hdIself) = inv_RecordExpressionBinding_s137 _hdX137 (T_RecordExpressionBinding_vIn136 ) + (T_RecordExpressionBindings_vOut139 _tlIself) = inv_RecordExpressionBindings_s140 _tlX140 (T_RecordExpressionBindings_vIn139 ) + _self = rule317 _hdIself _tlIself + _lhsOself :: RecordExpressionBindings + _lhsOself = rule318 _self + __result_ = T_RecordExpressionBindings_vOut139 _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule317 #-} + rule317 = \ ((_hdIself) :: RecordExpressionBinding) ((_tlIself) :: RecordExpressionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule318 #-} + rule318 = \ _self -> + _self +{-# NOINLINE sem_RecordExpressionBindings_Nil #-} +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 ) -> ( let + _self = rule319 () + _lhsOself :: RecordExpressionBindings + _lhsOself = rule320 _self + __result_ = T_RecordExpressionBindings_vOut139 _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule319 #-} + rule319 = \ (_ :: ()) -> + [] + {-# INLINE rule320 #-} + rule320 = \ _self -> + _self + +-- RecordPatternBinding ---------------------------------------- +-- wrapper +data Inh_RecordPatternBinding = Inh_RecordPatternBinding { } +data Syn_RecordPatternBinding = Syn_RecordPatternBinding { self_Syn_RecordPatternBinding :: (RecordPatternBinding) } +{-# INLINABLE wrap_RecordPatternBinding #-} +wrap_RecordPatternBinding :: T_RecordPatternBinding -> Inh_RecordPatternBinding -> (Syn_RecordPatternBinding ) +wrap_RecordPatternBinding (T_RecordPatternBinding act) (Inh_RecordPatternBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBinding_vIn142 + (T_RecordPatternBinding_vOut142 _lhsOself) <- return (inv_RecordPatternBinding_s143 sem arg) + return (Syn_RecordPatternBinding _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBinding #-} +sem_RecordPatternBinding :: RecordPatternBinding -> T_RecordPatternBinding +sem_RecordPatternBinding ( RecordPatternBinding_RecordPatternBinding range_ name_ pattern_ ) = sem_RecordPatternBinding_RecordPatternBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) + +-- semantic domain +newtype T_RecordPatternBinding = T_RecordPatternBinding { + attach_T_RecordPatternBinding :: Identity (T_RecordPatternBinding_s143 ) + } +newtype T_RecordPatternBinding_s143 = C_RecordPatternBinding_s143 { + inv_RecordPatternBinding_s143 :: (T_RecordPatternBinding_v142 ) + } +data T_RecordPatternBinding_s144 = C_RecordPatternBinding_s144 +type T_RecordPatternBinding_v142 = (T_RecordPatternBinding_vIn142 ) -> (T_RecordPatternBinding_vOut142 ) +data T_RecordPatternBinding_vIn142 = T_RecordPatternBinding_vIn142 +data T_RecordPatternBinding_vOut142 = T_RecordPatternBinding_vOut142 (RecordPatternBinding) +{-# NOINLINE sem_RecordPatternBinding_RecordPatternBinding #-} +sem_RecordPatternBinding_RecordPatternBinding :: T_Range -> T_Name -> T_Pattern -> T_RecordPatternBinding +sem_RecordPatternBinding_RecordPatternBinding arg_range_ arg_name_ arg_pattern_ = T_RecordPatternBinding (return st143) where + {-# NOINLINE st143 #-} + st143 = let + v142 :: T_RecordPatternBinding_v142 + v142 = \ (T_RecordPatternBinding_vIn142 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _self = rule321 _nameIself _patternIself _rangeIself + _lhsOself :: RecordPatternBinding + _lhsOself = rule322 _self + __result_ = T_RecordPatternBinding_vOut142 _lhsOself + in __result_ ) + in C_RecordPatternBinding_s143 v142 + {-# INLINE rule321 #-} + rule321 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + RecordPatternBinding_RecordPatternBinding _rangeIself _nameIself _patternIself + {-# INLINE rule322 #-} + rule322 = \ _self -> + _self + +-- RecordPatternBindings --------------------------------------- +-- wrapper +data Inh_RecordPatternBindings = Inh_RecordPatternBindings { } +data Syn_RecordPatternBindings = Syn_RecordPatternBindings { self_Syn_RecordPatternBindings :: (RecordPatternBindings) } +{-# INLINABLE wrap_RecordPatternBindings #-} +wrap_RecordPatternBindings :: T_RecordPatternBindings -> Inh_RecordPatternBindings -> (Syn_RecordPatternBindings ) +wrap_RecordPatternBindings (T_RecordPatternBindings act) (Inh_RecordPatternBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBindings_vIn145 + (T_RecordPatternBindings_vOut145 _lhsOself) <- return (inv_RecordPatternBindings_s146 sem arg) + return (Syn_RecordPatternBindings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBindings #-} +sem_RecordPatternBindings :: RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings list = Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list) + +-- semantic domain +newtype T_RecordPatternBindings = T_RecordPatternBindings { + attach_T_RecordPatternBindings :: Identity (T_RecordPatternBindings_s146 ) + } +newtype T_RecordPatternBindings_s146 = C_RecordPatternBindings_s146 { + inv_RecordPatternBindings_s146 :: (T_RecordPatternBindings_v145 ) + } +data T_RecordPatternBindings_s147 = C_RecordPatternBindings_s147 +type T_RecordPatternBindings_v145 = (T_RecordPatternBindings_vIn145 ) -> (T_RecordPatternBindings_vOut145 ) +data T_RecordPatternBindings_vIn145 = T_RecordPatternBindings_vIn145 +data T_RecordPatternBindings_vOut145 = T_RecordPatternBindings_vOut145 (RecordPatternBindings) +{-# NOINLINE sem_RecordPatternBindings_Cons #-} +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> T_RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings_Cons arg_hd_ arg_tl_ = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 ) -> ( let + _hdX143 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBinding (arg_hd_)) + _tlX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_tl_)) + (T_RecordPatternBinding_vOut142 _hdIself) = inv_RecordPatternBinding_s143 _hdX143 (T_RecordPatternBinding_vIn142 ) + (T_RecordPatternBindings_vOut145 _tlIself) = inv_RecordPatternBindings_s146 _tlX146 (T_RecordPatternBindings_vIn145 ) + _self = rule323 _hdIself _tlIself + _lhsOself :: RecordPatternBindings + _lhsOself = rule324 _self + __result_ = T_RecordPatternBindings_vOut145 _lhsOself + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule323 #-} + rule323 = \ ((_hdIself) :: RecordPatternBinding) ((_tlIself) :: RecordPatternBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule324 #-} + rule324 = \ _self -> + _self +{-# NOINLINE sem_RecordPatternBindings_Nil #-} +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 ) -> ( let + _self = rule325 () + _lhsOself :: RecordPatternBindings + _lhsOself = rule326 _self + __result_ = T_RecordPatternBindings_vOut145 _lhsOself + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule325 #-} + rule325 = \ (_ :: ()) -> + [] + {-# INLINE rule326 #-} + rule326 = \ _self -> + _self + +-- RightHandSide ----------------------------------------------- +-- wrapper +data Inh_RightHandSide = Inh_RightHandSide { } +data Syn_RightHandSide = Syn_RightHandSide { self_Syn_RightHandSide :: (RightHandSide) } +{-# INLINABLE wrap_RightHandSide #-} +wrap_RightHandSide :: T_RightHandSide -> Inh_RightHandSide -> (Syn_RightHandSide ) +wrap_RightHandSide (T_RightHandSide act) (Inh_RightHandSide ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RightHandSide_vIn148 + (T_RightHandSide_vOut148 _lhsOself) <- return (inv_RightHandSide_s149 sem arg) + return (Syn_RightHandSide _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RightHandSide #-} +sem_RightHandSide :: RightHandSide -> T_RightHandSide +sem_RightHandSide ( RightHandSide_Expression range_ expression_ where_ ) = sem_RightHandSide_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_MaybeDeclarations where_ ) +sem_RightHandSide ( RightHandSide_Guarded range_ guardedexpressions_ where_ ) = sem_RightHandSide_Guarded ( sem_Range range_ ) ( sem_GuardedExpressions guardedexpressions_ ) ( sem_MaybeDeclarations where_ ) + +-- semantic domain +newtype T_RightHandSide = T_RightHandSide { + attach_T_RightHandSide :: Identity (T_RightHandSide_s149 ) + } +newtype T_RightHandSide_s149 = C_RightHandSide_s149 { + inv_RightHandSide_s149 :: (T_RightHandSide_v148 ) + } +data T_RightHandSide_s150 = C_RightHandSide_s150 +type T_RightHandSide_v148 = (T_RightHandSide_vIn148 ) -> (T_RightHandSide_vOut148 ) +data T_RightHandSide_vIn148 = T_RightHandSide_vIn148 +data T_RightHandSide_vOut148 = T_RightHandSide_vOut148 (RightHandSide) +{-# NOINLINE sem_RightHandSide_Expression #-} +sem_RightHandSide_Expression :: T_Range -> T_Expression -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Expression arg_range_ arg_expression_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_MaybeDeclarations_vOut88 _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _self = rule327 _expressionIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule328 _self + __result_ = T_RightHandSide_vOut148 _lhsOself + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule327 #-} + rule327 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Expression _rangeIself _expressionIself _whereIself + {-# INLINE rule328 #-} + rule328 = \ _self -> + _self +{-# NOINLINE sem_RightHandSide_Guarded #-} +sem_RightHandSide_Guarded :: T_Range -> T_GuardedExpressions -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Guarded arg_range_ arg_guardedexpressions_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardedexpressionsX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_guardedexpressions_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_GuardedExpressions_vOut64 _guardedexpressionsIself) = inv_GuardedExpressions_s65 _guardedexpressionsX65 (T_GuardedExpressions_vIn64 ) + (T_MaybeDeclarations_vOut88 _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _self = rule329 _guardedexpressionsIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule330 _self + __result_ = T_RightHandSide_vOut148 _lhsOself + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule329 #-} + rule329 = \ ((_guardedexpressionsIself) :: GuardedExpressions) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Guarded _rangeIself _guardedexpressionsIself _whereIself + {-# INLINE rule330 #-} + rule330 = \ _self -> + _self + +-- SimpleType -------------------------------------------------- +-- wrapper +data Inh_SimpleType = Inh_SimpleType { } +data Syn_SimpleType = Syn_SimpleType { self_Syn_SimpleType :: (SimpleType) } +{-# INLINABLE wrap_SimpleType #-} +wrap_SimpleType :: T_SimpleType -> Inh_SimpleType -> (Syn_SimpleType ) +wrap_SimpleType (T_SimpleType act) (Inh_SimpleType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_SimpleType_vIn151 + (T_SimpleType_vOut151 _lhsOself) <- return (inv_SimpleType_s152 sem arg) + return (Syn_SimpleType _lhsOself) + ) + +-- cata +{-# INLINE sem_SimpleType #-} +sem_SimpleType :: SimpleType -> T_SimpleType +sem_SimpleType ( SimpleType_SimpleType range_ name_ typevariables_ ) = sem_SimpleType_SimpleType ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Names typevariables_ ) + +-- semantic domain +newtype T_SimpleType = T_SimpleType { + attach_T_SimpleType :: Identity (T_SimpleType_s152 ) + } +newtype T_SimpleType_s152 = C_SimpleType_s152 { + inv_SimpleType_s152 :: (T_SimpleType_v151 ) + } +data T_SimpleType_s153 = C_SimpleType_s153 +type T_SimpleType_v151 = (T_SimpleType_vIn151 ) -> (T_SimpleType_vOut151 ) +data T_SimpleType_vIn151 = T_SimpleType_vIn151 +data T_SimpleType_vOut151 = T_SimpleType_vOut151 (SimpleType) +{-# NOINLINE sem_SimpleType_SimpleType #-} +sem_SimpleType_SimpleType :: T_Range -> T_Name -> T_Names -> T_SimpleType +sem_SimpleType_SimpleType arg_range_ arg_name_ arg_typevariables_ = T_SimpleType (return st152) where + {-# NOINLINE st152 #-} + st152 = let + v151 :: T_SimpleType_v151 + v151 = \ (T_SimpleType_vIn151 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Names_vOut115 _typevariablesInames _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + _self = rule331 _nameIself _rangeIself _typevariablesIself + _lhsOself :: SimpleType + _lhsOself = rule332 _self + __result_ = T_SimpleType_vOut151 _lhsOself + in __result_ ) + in C_SimpleType_s152 v151 + {-# INLINE rule331 #-} + rule331 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typevariablesIself) :: Names) -> + SimpleType_SimpleType _rangeIself _nameIself _typevariablesIself + {-# INLINE rule332 #-} + rule332 = \ _self -> + _self + +-- Statement --------------------------------------------------- +-- wrapper +data Inh_Statement = Inh_Statement { } +data Syn_Statement = Syn_Statement { self_Syn_Statement :: (Statement) } +{-# INLINABLE wrap_Statement #-} +wrap_Statement :: T_Statement -> Inh_Statement -> (Syn_Statement ) +wrap_Statement (T_Statement act) (Inh_Statement ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statement_vIn154 + (T_Statement_vOut154 _lhsOself) <- return (inv_Statement_s155 sem arg) + return (Syn_Statement _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statement #-} +sem_Statement :: Statement -> T_Statement +sem_Statement ( Statement_Expression range_ expression_ ) = sem_Statement_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Let range_ declarations_ ) = sem_Statement_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Statement ( Statement_Generator range_ pattern_ expression_ ) = sem_Statement_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Empty range_ ) = sem_Statement_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Statement = T_Statement { + attach_T_Statement :: Identity (T_Statement_s155 ) + } +newtype T_Statement_s155 = C_Statement_s155 { + inv_Statement_s155 :: (T_Statement_v154 ) + } +data T_Statement_s156 = C_Statement_s156 +type T_Statement_v154 = (T_Statement_vIn154 ) -> (T_Statement_vOut154 ) +data T_Statement_vIn154 = T_Statement_vIn154 +data T_Statement_vOut154 = T_Statement_vOut154 (Statement) +{-# NOINLINE sem_Statement_Expression #-} +sem_Statement_Expression :: T_Range -> T_Expression -> T_Statement +sem_Statement_Expression arg_range_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule333 _expressionIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule334 _self + __result_ = T_Statement_vOut154 _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule333 #-} + rule333 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Statement_Expression _rangeIself _expressionIself + {-# INLINE rule334 #-} + rule334 = \ _self -> + _self +{-# NOINLINE sem_Statement_Let #-} +sem_Statement_Let :: T_Range -> T_Declarations -> T_Statement +sem_Statement_Let arg_range_ arg_declarations_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _self = rule335 _declarationsIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule336 _self + __result_ = T_Statement_vOut154 _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule335 #-} + rule335 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Statement_Let _rangeIself _declarationsIself + {-# INLINE rule336 #-} + rule336 = \ _self -> + _self +{-# NOINLINE sem_Statement_Generator #-} +sem_Statement_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Statement +sem_Statement_Generator arg_range_ arg_pattern_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_Expression_vOut40 _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule337 _expressionIself _patternIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule338 _self + __result_ = T_Statement_vOut154 _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule337 #-} + rule337 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Statement_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule338 #-} + rule338 = \ _self -> + _self +{-# NOINLINE sem_Statement_Empty #-} +sem_Statement_Empty :: T_Range -> T_Statement +sem_Statement_Empty arg_range_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule339 _rangeIself + _lhsOself :: Statement + _lhsOself = rule340 _self + __result_ = T_Statement_vOut154 _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule339 #-} + rule339 = \ ((_rangeIself) :: Range) -> + Statement_Empty _rangeIself + {-# INLINE rule340 #-} + rule340 = \ _self -> + _self + +-- Statements -------------------------------------------------- +-- wrapper +data Inh_Statements = Inh_Statements { } +data Syn_Statements = Syn_Statements { self_Syn_Statements :: (Statements) } +{-# INLINABLE wrap_Statements #-} +wrap_Statements :: T_Statements -> Inh_Statements -> (Syn_Statements ) +wrap_Statements (T_Statements act) (Inh_Statements ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statements_vIn157 + (T_Statements_vOut157 _lhsOself) <- return (inv_Statements_s158 sem arg) + return (Syn_Statements _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statements #-} +sem_Statements :: Statements -> T_Statements +sem_Statements list = Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list) + +-- semantic domain +newtype T_Statements = T_Statements { + attach_T_Statements :: Identity (T_Statements_s158 ) + } +newtype T_Statements_s158 = C_Statements_s158 { + inv_Statements_s158 :: (T_Statements_v157 ) + } +data T_Statements_s159 = C_Statements_s159 +type T_Statements_v157 = (T_Statements_vIn157 ) -> (T_Statements_vOut157 ) +data T_Statements_vIn157 = T_Statements_vIn157 +data T_Statements_vOut157 = T_Statements_vOut157 (Statements) +{-# NOINLINE sem_Statements_Cons #-} +sem_Statements_Cons :: T_Statement -> T_Statements -> T_Statements +sem_Statements_Cons arg_hd_ arg_tl_ = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 ) -> ( let + _hdX155 = Control.Monad.Identity.runIdentity (attach_T_Statement (arg_hd_)) + _tlX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_tl_)) + (T_Statement_vOut154 _hdIself) = inv_Statement_s155 _hdX155 (T_Statement_vIn154 ) + (T_Statements_vOut157 _tlIself) = inv_Statements_s158 _tlX158 (T_Statements_vIn157 ) + _self = rule341 _hdIself _tlIself + _lhsOself :: Statements + _lhsOself = rule342 _self + __result_ = T_Statements_vOut157 _lhsOself + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule341 #-} + rule341 = \ ((_hdIself) :: Statement) ((_tlIself) :: Statements) -> + (:) _hdIself _tlIself + {-# INLINE rule342 #-} + rule342 = \ _self -> + _self +{-# NOINLINE sem_Statements_Nil #-} +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 ) -> ( let + _self = rule343 () + _lhsOself :: Statements + _lhsOself = rule344 _self + __result_ = T_Statements_vOut157 _lhsOself + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule343 #-} + rule343 = \ (_ :: ()) -> + [] + {-# INLINE rule344 #-} + rule344 = \ _self -> + _self + +-- Strings ----------------------------------------------------- +-- wrapper +data Inh_Strings = Inh_Strings { } +data Syn_Strings = Syn_Strings { self_Syn_Strings :: (Strings) } +{-# INLINABLE wrap_Strings #-} +wrap_Strings :: T_Strings -> Inh_Strings -> (Syn_Strings ) +wrap_Strings (T_Strings act) (Inh_Strings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Strings_vIn160 + (T_Strings_vOut160 _lhsOself) <- return (inv_Strings_s161 sem arg) + return (Syn_Strings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Strings #-} +sem_Strings :: Strings -> T_Strings +sem_Strings list = Prelude.foldr sem_Strings_Cons sem_Strings_Nil list + +-- semantic domain +newtype T_Strings = T_Strings { + attach_T_Strings :: Identity (T_Strings_s161 ) + } +newtype T_Strings_s161 = C_Strings_s161 { + inv_Strings_s161 :: (T_Strings_v160 ) + } +data T_Strings_s162 = C_Strings_s162 +type T_Strings_v160 = (T_Strings_vIn160 ) -> (T_Strings_vOut160 ) +data T_Strings_vIn160 = T_Strings_vIn160 +data T_Strings_vOut160 = T_Strings_vOut160 (Strings) +{-# NOINLINE sem_Strings_Cons #-} +sem_Strings_Cons :: (String) -> T_Strings -> T_Strings +sem_Strings_Cons arg_hd_ arg_tl_ = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _tlX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_tl_)) + (T_Strings_vOut160 _tlIself) = inv_Strings_s161 _tlX161 (T_Strings_vIn160 ) + _self = rule345 _tlIself arg_hd_ + _lhsOself :: Strings + _lhsOself = rule346 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule345 #-} + rule345 = \ ((_tlIself) :: Strings) hd_ -> + (:) hd_ _tlIself + {-# INLINE rule346 #-} + rule346 = \ _self -> + _self +{-# NOINLINE sem_Strings_Nil #-} +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _self = rule347 () + _lhsOself :: Strings + _lhsOself = rule348 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule347 #-} + rule347 = \ (_ :: ()) -> + [] + {-# INLINE rule348 #-} + rule348 = \ _self -> + _self + +-- Type -------------------------------------------------------- +-- wrapper +data Inh_Type = Inh_Type { } +data Syn_Type = Syn_Type { self_Syn_Type :: (Type) } +{-# INLINABLE wrap_Type #-} +wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) +wrap_Type (T_Type act) (Inh_Type ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Type_vIn163 + (T_Type_vOut163 _lhsOself) <- return (inv_Type_s164 sem arg) + return (Syn_Type _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Type #-} +sem_Type :: Type -> T_Type +sem_Type ( Type_Application range_ prefix_ function_ arguments_ ) = sem_Type_Application ( sem_Range range_ ) prefix_ ( sem_Type function_ ) ( sem_Types arguments_ ) +sem_Type ( Type_Variable range_ name_ ) = sem_Type_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Constructor range_ name_ ) = sem_Type_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Qualified range_ context_ type_ ) = sem_Type_Qualified ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Type type_ ) +sem_Type ( Type_Forall range_ typevariables_ type_ ) = sem_Type_Forall ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Exists range_ typevariables_ type_ ) = sem_Type_Exists ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Parenthesized range_ type_ ) = sem_Type_Parenthesized ( sem_Range range_ ) ( sem_Type type_ ) + +-- semantic domain +newtype T_Type = T_Type { + attach_T_Type :: Identity (T_Type_s164 ) + } +newtype T_Type_s164 = C_Type_s164 { + inv_Type_s164 :: (T_Type_v163 ) + } +data T_Type_s165 = C_Type_s165 +type T_Type_v163 = (T_Type_vIn163 ) -> (T_Type_vOut163 ) +data T_Type_vIn163 = T_Type_vIn163 +data T_Type_vOut163 = T_Type_vOut163 (Type) +{-# NOINLINE sem_Type_Application #-} +sem_Type_Application :: T_Range -> (Bool) -> T_Type -> T_Types -> T_Type +sem_Type_Application arg_range_ arg_prefix_ arg_function_ arg_arguments_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_function_)) + _argumentsX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _functionIself) = inv_Type_s164 _functionX164 (T_Type_vIn163 ) + (T_Types_vOut166 _argumentsIself) = inv_Types_s167 _argumentsX167 (T_Types_vIn166 ) + _self = rule349 _argumentsIself _functionIself _rangeIself arg_prefix_ + _lhsOself :: Type + _lhsOself = rule350 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule349 #-} + rule349 = \ ((_argumentsIself) :: Types) ((_functionIself) :: Type) ((_rangeIself) :: Range) prefix_ -> + Type_Application _rangeIself prefix_ _functionIself _argumentsIself + {-# INLINE rule350 #-} + rule350 = \ _self -> + _self +{-# NOINLINE sem_Type_Variable #-} +sem_Type_Variable :: T_Range -> T_Name -> T_Type +sem_Type_Variable arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule351 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule352 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule351 #-} + rule351 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Variable _rangeIself _nameIself + {-# INLINE rule352 #-} + rule352 = \ _self -> + _self +{-# NOINLINE sem_Type_Constructor #-} +sem_Type_Constructor :: T_Range -> T_Name -> T_Type +sem_Type_Constructor arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule353 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule354 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule353 #-} + rule353 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Constructor _rangeIself _nameIself + {-# INLINE rule354 #-} + rule354 = \ _self -> + _self +{-# NOINLINE sem_Type_Qualified #-} +sem_Type_Qualified :: T_Range -> T_ContextItems -> T_Type -> T_Type +sem_Type_Qualified arg_range_ arg_context_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule355 _contextIself _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule356 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule355 #-} + rule355 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Qualified _rangeIself _contextIself _typeIself + {-# INLINE rule356 #-} + rule356 = \ _self -> + _self +{-# NOINLINE sem_Type_Forall #-} +sem_Type_Forall :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Forall arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesInames _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule357 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule358 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule357 #-} + rule357 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Forall _rangeIself _typevariablesIself _typeIself + {-# INLINE rule358 #-} + rule358 = \ _self -> + _self +{-# NOINLINE sem_Type_Exists #-} +sem_Type_Exists :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Exists arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesInames _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule359 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule360 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule359 #-} + rule359 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Exists _rangeIself _typevariablesIself _typeIself + {-# INLINE rule360 #-} + rule360 = \ _self -> + _self +{-# NOINLINE sem_Type_Parenthesized #-} +sem_Type_Parenthesized :: T_Range -> T_Type -> T_Type +sem_Type_Parenthesized arg_range_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule361 _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule362 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule361 #-} + rule361 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Parenthesized _rangeIself _typeIself + {-# INLINE rule362 #-} + rule362 = \ _self -> + _self + +-- Types ------------------------------------------------------- +-- wrapper +data Inh_Types = Inh_Types { } +data Syn_Types = Syn_Types { self_Syn_Types :: (Types) } +{-# INLINABLE wrap_Types #-} +wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) +wrap_Types (T_Types act) (Inh_Types ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Types_vIn166 + (T_Types_vOut166 _lhsOself) <- return (inv_Types_s167 sem arg) + return (Syn_Types _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Types #-} +sem_Types :: Types -> T_Types +sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) + +-- semantic domain +newtype T_Types = T_Types { + attach_T_Types :: Identity (T_Types_s167 ) + } +newtype T_Types_s167 = C_Types_s167 { + inv_Types_s167 :: (T_Types_v166 ) + } +data T_Types_s168 = C_Types_s168 +type T_Types_v166 = (T_Types_vIn166 ) -> (T_Types_vOut166 ) +data T_Types_vIn166 = T_Types_vIn166 +data T_Types_vOut166 = T_Types_vOut166 (Types) +{-# NOINLINE sem_Types_Cons #-} +sem_Types_Cons :: T_Type -> T_Types -> T_Types +sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _hdX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) + _tlX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) + (T_Type_vOut163 _hdIself) = inv_Type_s164 _hdX164 (T_Type_vIn163 ) + (T_Types_vOut166 _tlIself) = inv_Types_s167 _tlX167 (T_Types_vIn166 ) + _self = rule363 _hdIself _tlIself + _lhsOself :: Types + _lhsOself = rule364 _self + __result_ = T_Types_vOut166 _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule363 #-} + rule363 = \ ((_hdIself) :: Type) ((_tlIself) :: Types) -> + (:) _hdIself _tlIself + {-# INLINE rule364 #-} + rule364 = \ _self -> + _self +{-# NOINLINE sem_Types_Nil #-} +sem_Types_Nil :: T_Types +sem_Types_Nil = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _self = rule365 () + _lhsOself :: Types + _lhsOself = rule366 _self + __result_ = T_Types_vOut166 _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule365 #-} + rule365 = \ (_ :: ()) -> + [] + {-# INLINE rule366 #-} + rule366 = \ _self -> + _self diff --git a/src/Helium/ModuleSystem/ImportEnvironment.hs b/src/Helium/ModuleSystem/ImportEnvironment.hs new file mode 100644 --- /dev/null +++ b/src/Helium/ModuleSystem/ImportEnvironment.hs @@ -0,0 +1,282 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| Module : ImportEnvironment + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.ModuleSystem.ImportEnvironment where + +import qualified Data.Map as M +import Helium.Utils.Utils (internalError) +import Helium.Syntax.UHA_Syntax -- (Name) +import Helium.Syntax.UHA_Utils +import Top.Types +import Helium.Parser.OperatorTable +import Helium.StaticAnalysis.Messages.Messages () -- instance Show Name +import Helium.StaticAnalysis.Heuristics.RepairHeuristics (Siblings) +import Helium.StaticAnalysis.Directives.TS_CoreSyntax +import Data.List +import Data.Maybe (catMaybes) +import Data.Function (on) + +type TypeEnvironment = M.Map Name TpScheme +type ValueConstructorEnvironment = M.Map Name TpScheme +type TypeConstructorEnvironment = M.Map Name Int +type TypeSynonymEnvironment = M.Map Name (Int, Tps -> Tp) + +type ImportEnvironments = [ImportEnvironment] +data ImportEnvironment = + ImportEnvironment { -- types + typeConstructors :: TypeConstructorEnvironment + , typeSynonyms :: TypeSynonymEnvironment + , typeEnvironment :: TypeEnvironment + -- values + , valueConstructors :: ValueConstructorEnvironment + , operatorTable :: OperatorTable +-- -- type classes +-- , classEnvironment :: ClassEnvironment + -- other + , typingStrategies :: Core_TypingStrategies + } + +emptyEnvironment :: ImportEnvironment +emptyEnvironment = ImportEnvironment + { typeConstructors = M.empty + , typeSynonyms = M.empty + , typeEnvironment = M.empty + , valueConstructors = M.empty + , operatorTable = M.empty +-- , classEnvironment = emptyClassEnvironment + , typingStrategies = [] + } + +addTypeConstructor :: Name -> Int -> ImportEnvironment -> ImportEnvironment +addTypeConstructor name int importenv = + importenv {typeConstructors = M.insert name int (typeConstructors importenv)} + +-- add a type synonym also to the type constructor environment +addTypeSynonym :: Name -> (Int,Tps -> Tp) -> ImportEnvironment -> ImportEnvironment +addTypeSynonym name (arity, function) importenv = + importenv { typeSynonyms = M.insert name (arity, function) (typeSynonyms importenv) + , typeConstructors = M.insert name arity (typeConstructors importenv) + } + +addType :: Name -> TpScheme -> ImportEnvironment -> ImportEnvironment +addType name tpscheme importenv = + importenv {typeEnvironment = M.insert name tpscheme (typeEnvironment importenv)} + +addToTypeEnvironment :: TypeEnvironment -> ImportEnvironment -> ImportEnvironment +addToTypeEnvironment new importenv = + importenv {typeEnvironment = typeEnvironment importenv `M.union` new} + +addValueConstructor :: Name -> TpScheme -> ImportEnvironment -> ImportEnvironment +addValueConstructor name tpscheme importenv = + importenv {valueConstructors = M.insert name tpscheme (valueConstructors importenv)} + +addOperator :: Name -> (Int,Assoc) -> ImportEnvironment -> ImportEnvironment +addOperator name pair importenv = + importenv {operatorTable = M.insert name pair (operatorTable importenv) } + +setValueConstructors :: M.Map Name TpScheme -> ImportEnvironment -> ImportEnvironment +setValueConstructors new importenv = importenv {valueConstructors = new} + +setTypeConstructors :: M.Map Name Int -> ImportEnvironment -> ImportEnvironment +setTypeConstructors new importenv = importenv {typeConstructors = new} + +setTypeSynonyms :: M.Map Name (Int,Tps -> Tp) -> ImportEnvironment -> ImportEnvironment +setTypeSynonyms new importenv = importenv {typeSynonyms = new} + +setTypeEnvironment :: M.Map Name TpScheme -> ImportEnvironment -> ImportEnvironment +setTypeEnvironment new importenv = importenv {typeEnvironment = new} + +setOperatorTable :: OperatorTable -> ImportEnvironment -> ImportEnvironment +setOperatorTable new importenv = importenv {operatorTable = new} + +getOrderedTypeSynonyms :: ImportEnvironment -> OrderedTypeSynonyms +getOrderedTypeSynonyms importEnvironment = + let synonyms = let insertIt name = M.insert (show name) + in M.foldWithKey insertIt M.empty (typeSynonyms importEnvironment) + ordering = fst (getTypeSynonymOrdering synonyms) + in (ordering, synonyms) + +{- +setClassEnvironment :: ClassEnvironment -> ImportEnvironment -> ImportEnvironment +setClassEnvironment new importenv = importenv { classEnvironment = new } +-} + +addTypingStrategies :: Core_TypingStrategies -> ImportEnvironment -> ImportEnvironment +addTypingStrategies new importenv = importenv {typingStrategies = new ++ typingStrategies importenv} + +removeTypingStrategies :: ImportEnvironment -> ImportEnvironment +removeTypingStrategies importenv = importenv {typingStrategies = []} + +getSiblingGroups :: ImportEnvironment -> [[String]] +getSiblingGroups importenv = + [ xs | Siblings xs <- typingStrategies importenv ] + +getSiblings :: ImportEnvironment -> Siblings +getSiblings importenv = + let f s = [ (s, ts) | ts <- findTpScheme (nameFromString s) ] + findTpScheme n = + catMaybes [ M.lookup n (valueConstructors importenv) + , M.lookup n (typeEnvironment importenv) + ] + in map (concatMap f) (getSiblingGroups importenv) + +combineImportEnvironments :: ImportEnvironment -> ImportEnvironment -> ImportEnvironment +combineImportEnvironments (ImportEnvironment tcs1 tss1 te1 vcs1 ot1 xs1) (ImportEnvironment tcs2 tss2 te2 vcs2 ot2 xs2) = + ImportEnvironment + (tcs1 `exclusiveUnion` tcs2) + (tss1 `exclusiveUnion` tss2) + (te1 `exclusiveUnion` te2 ) + (vcs1 `exclusiveUnion` vcs2) + (ot1 `exclusiveUnion` ot2) + (xs1 ++ xs2) + +exclusiveUnion :: Ord key => M.Map key a -> M.Map key a -> M.Map key a +exclusiveUnion m1 m2 = + let keys = M.keys (M.intersection m1 m2) + f m = foldr (M.update (const Nothing)) m keys + in f m1 `M.union` f m2 + +{- +-- Bastiaan: +-- For the moment, this function combines class-environments. +-- The only instances that are added to the standard instances +-- are the derived Show instances (Show has no superclasses). +-- If other instances are added too, then the class environment +-- should be split into a class declaration environment, and an +-- instance environment. +combineClassDecls :: ([[Char]],[(Predicate,[Predicate])]) -> + ([[Char]],[(Predicate,[Predicate])]) -> + ([[Char]],[(Predicate,[Predicate])]) +combineClassDecls (super1, inst1) (super2, inst2) + | super1 == super2 = (super1, inst1 ++ inst2) + | otherwise = internalError "ImportEnvironment.hs" "combineClassDecls" "cannot combine class environments" +-} + +-- Bastiaan: +-- Create a class environment from the dictionaries in the import environment +createClassEnvironment :: ImportEnvironment -> ClassEnvironment +createClassEnvironment importenv = + let dicts = map (drop (length dictPrefix) . show) + . M.keys + . M.filterWithKey isDict + $ typeEnvironment importenv + isDict n _ = dictPrefix `isPrefixOf` show n + dictPrefix = "$dict" + -- classes = ["Eq","Num","Ord","Enum","Show"] + -- TODO: put $ between class name and type in dictionary name + -- i.e. $dictEq$Int instead of $dictEqInt + splitDictName ('E':'q':t) = ("Eq", t) + splitDictName ('N':'u':'m':t) = ("Num", t) + splitDictName ('O':'r':'d':t) = ("Ord", t) + splitDictName ('E':'n':'u':'m':t) = ("Enum", t) + splitDictName ('S':'h':'o':'w':t) = ("Show", t) + splitDictName x = internalError "ImportEnvironment" "splitDictName" ("illegal dictionary: " ++ show x) + arity s | s == "()" = 0 + | isTupleConstructor s = length s - 1 + | otherwise = M.findWithDefault + (internalError "ImportEnvironment" "splitDictName" ("unknown type constructor: " ++ show s)) + (nameFromString s) + (typeConstructors importenv) + dictTuples = [ (c, makeInstance c (arity t) t) + | d <- dicts, let (c, t) = splitDictName d + ] + + classEnv = foldr + (\(className, inst) e -> insertInstance className inst e) + superClassRelation + dictTuples + in classEnv + +superClassRelation :: ClassEnvironment +superClassRelation = M.fromList + [ ("Num", ( ["Eq","Show"], [])) + , ("Enum", ( [], [])) + , ("Eq" , ( [], [])) + , ("Ord", ( ["Eq"], [])) + , ("Show", ( [], [])) + ] + +makeInstance :: String -> Int -> String -> Instance +makeInstance className nrOfArgs tp = + let tps = take nrOfArgs [ TVar i | i <- [0..] ] + in ( Predicate className (foldl TApp (TCon tp) tps) + , [ Predicate className x | x <- tps ] + ) + + +-- added for holmes +holmesShowImpEnv :: Module -> ImportEnvironment -> String +holmesShowImpEnv module_ (ImportEnvironment _ _ te _ _ _) = + concat functions + where + localName = getModuleName module_ + functions = + let (xs, ys) = partition (isIdentifierName . fst) (M.assocs te) + list = map (\(n,_) -> getHolmesName localName n) (ys++xs) + in map (++ ";") list + +instance Show ImportEnvironment where + show (ImportEnvironment tcs tss te vcs ot _) = + unlines (concat [ fixities + , datatypes + , typesynonyms + , theValueConstructors + , functions + ]) + where + fixities = + let sorted = let cmp (name, (priority, associativity)) = (10 - priority, associativity, not (isOperatorName name), name) + in sortBy (compare `on` cmp) (M.assocs ot) + grouped = groupBy ((==) `on` snd) sorted + list = let f ((name, (priority, associativity)) : rest) = + let names = name : map fst rest + prefix = (case associativity of + AssocRight -> "infixr" + AssocLeft -> "infixl" + AssocNone -> "infix " + )++" "++ show priority ++ " " + in prefix ++ foldr1 (\x y -> x++", "++y) (map showNameAsOperator names) + f [] = error "Pattern match failure in ModuleSystem.ImportEnvironment" + in map f grouped + in showWithTitle "Fixity declarations" list + + datatypes = + let allDatas = filter ((`notElem` M.keys tss). fst) (M.assocs tcs) + (xs, ys) = partition (isIdentifierName . fst) allDatas + list = map f (ys++xs) + f (n,i) = unwords ("data" : showNameAsVariable n : take i variableList) + in showWithTitle "Data types" list + + typesynonyms = + let (xs, ys) = partition (isIdentifierName . fst) (M.assocs tss) + list = map f (ys++xs) + f (n,(i,g)) = let tcons = take i (map TCon variableList) + in unwords ("type" : showNameAsVariable n : map show tcons ++ ["=", show (g tcons)]) + in showWithTitle "Type synonyms" list + + theValueConstructors = + let (xs, ys) = partition (isIdentifierName . fst) (M.assocs vcs) + list = map (\(n,t) -> showNameAsVariable n ++ " :: "++show t) (ys++xs) + in showWithTitle "Value constructors" list + + functions = + let (xs, ys) = partition (isIdentifierName . fst) (M.assocs te) + list = map (\(n,t) -> showNameAsVariable n ++ " :: "++show t) (ys++xs) + in showWithTitle "Functions" list + + showWithTitle title xs + | null xs = [] + | otherwise = (title++":") : map (" "++) xs + +instance Ord Assoc where + x <= y = let f :: Assoc -> Int + f AssocLeft = 0 + f AssocRight = 1 + f AssocNone = 2 + in f x <= f y diff --git a/src/Helium/Parser/CollectFunctionBindings.hs b/src/Helium/Parser/CollectFunctionBindings.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/CollectFunctionBindings.hs @@ -0,0 +1,79 @@ +{-| Module : CollectFunctionBindings + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Parser.CollectFunctionBindings where + +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils () +import Helium.Syntax.UHA_Range +import Helium.Utils.Utils + +-- Assumption: each FunctionBindings contains exactly one FunctionBinding + +decls :: Declarations -> Declarations +decls = decls' . mergeFeedback + +mergeFeedback :: Declarations -> Declarations +mergeFeedback [] = [] +mergeFeedback (Declaration_FunctionBindings _ [FunctionBinding_Feedback rfb fb _]:ds) = + case mergeFeedback ds of + Declaration_FunctionBindings rdcls (funb : fbs) : mds -> + Declaration_FunctionBindings + (mergeRanges rfb rdcls) + (FunctionBinding_Feedback (mergeRanges rfb $ rangeOfFunctionBinding funb) fb funb : fbs) : mds + rs -> rs +mergeFeedback (x : xs) = x : mergeFeedback xs + +decls' :: Declarations -> Declarations +decls' [] = [] +decls' (d@(Declaration_FunctionBindings _ [_]):ds) = + let mn = nameOfDeclaration d + (same, others) = span ((== mn) . nameOfDeclaration) (d:ds) + fs = map functionBindingOfDeclaration same + in Declaration_FunctionBindings + (mergeRanges (rangeOfFunctionBinding (head fs)) (rangeOfFunctionBinding (last fs))) + fs + : + decls' others +decls' (Declaration_FunctionBindings _ _:_) = + internalError "CollectFunctionBindings" "decls" "not exactly one function binding in FunctionBindings" +decls' (d:ds) = d : decls' ds + +functionBindingOfDeclaration :: Declaration -> FunctionBinding +functionBindingOfDeclaration (Declaration_FunctionBindings _ [f]) = f +functionBindingOfDeclaration _ = + internalError "CollectFunctionBindings" "getFunctionBinding" "unexpected declaration kind" + +rangeOfFunctionBinding :: FunctionBinding -> Range +rangeOfFunctionBinding (FunctionBinding_FunctionBinding r _ _) = r +rangeOfFunctionBinding (FunctionBinding_Feedback r _ _) = r +rangeOfFunctionBinding (FunctionBinding_Hole _ _) = error "not supported" + +nameOfDeclaration :: Declaration -> Maybe Name +nameOfDeclaration d = + case d of + Declaration_FunctionBindings _ [FunctionBinding_FunctionBinding _ l _] -> + Just (nameOfLeftHandSide l) + Declaration_FunctionBindings r [FunctionBinding_Feedback _ _ fb] -> + nameOfDeclaration (Declaration_FunctionBindings r [fb]) + _ -> Nothing + +nameOfLeftHandSide :: LeftHandSide -> Name +nameOfLeftHandSide lhs = + case lhs of + LeftHandSide_Function _ n _ -> n + LeftHandSide_Infix _ _ n _ -> n + LeftHandSide_Parenthesized _ innerLhs _ -> nameOfLeftHandSide innerLhs + +mergeCaseFeedback :: Alternatives -> Alternatives +mergeCaseFeedback [] = [] +mergeCaseFeedback (Alternative_Feedback r v _ : rs) = + case mergeCaseFeedback rs of + [] -> [] + (x : xs) -> Alternative_Feedback r v x : xs +mergeCaseFeedback (x : xs) = x : mergeCaseFeedback xs diff --git a/src/Helium/Parser/LayoutRule.hs b/src/Helium/Parser/LayoutRule.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/LayoutRule.hs @@ -0,0 +1,112 @@ +{-| Module : LayoutRule + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Parser.LayoutRule(layout) where + +import Helium.Parser.LexerToken(Token, Lexeme(..), lexemeLength) +import Text.ParserCombinators.Parsec.Pos + +layout :: [Token] -> [Token] +layout [] = [] +layout input@((pos, lexeme):_) = optimise $ + case lexeme of + LexKeyword "module" -> + lay dummyToken [] input + LexSpecial '{' -> + lay dummyToken [] input + _ -> + (pos, LexInsertedOpenBrace) : + lay dummyToken [CtxLay (sourceColumn pos) False] input + where + zeroPos = setSourceColumn (setSourceLine pos 0) 0 + dummyToken = (zeroPos, LexVar "") + +optimise :: [Token] -> [Token] +optimise (token1@(_, LexInsertedOpenBrace) : (_, LexInsertedSemicolon) : ts) = + optimise (token1 : ts) +optimise (t:ts) = + t : optimise ts +optimise [] = [] + +data Context + = CtxLay Int Bool {- let? -} + | CtxBrace + deriving (Eq,Show) + +-- previous token +-- enclosing contexts +lay :: Token -> [Context] -> [Token] -> [Token] + +-- If we're in a CtxBrace and we see a '}', we leave that context. +-- If we see another token, we check to see if we need to add a +-- new context. +lay _ + cc@(CtxBrace:cs) + input@(t@(_, lexeme):ts) + | lexeme == LexSpecial '}' = + t : lay t cs ts + | otherwise = + t : addContext t cc input + +-- If we're in a let layout context, an 'in' can end +-- the context, too. +lay prevToken + (CtxLay _ True:cs) + (t@(_, LexKeyword "in"):ts) + = (behind prevToken, LexInsertedCloseBrace) : t : lay t cs ts + +-- If we're in a layout context and the new token is not on the +-- same line as the previous, we check the column against the +-- context. If the new token is on the same line, we only need +-- to check whether a context has to be added. +lay prevToken@(prevPos, _) + cc@(CtxLay ctxCol _:cs) + input@(t@(pos, _):_) + | sourceLine pos > sourceLine prevPos = -- token on next line? + if sourceColumn pos > ctxCol then -- indent more => nothing + t : addContext t cc input + else if sourceColumn pos == ctxCol then -- indent same => insert ';' + (behind prevToken, LexInsertedSemicolon) : t : addContext t cc input + else -- indent less => insert brace, remove context and try again + (behind prevToken, LexInsertedCloseBrace) : lay prevToken cs input + | otherwise = -- token on same line + t : addContext t cc input + +lay _ _ [] = [] + +lay _ [] input@(t@(_, _):_) = + t : addContext t [] input + +behind :: Token -> SourcePos +behind (pos, lexeme) = incSourceColumn pos (lexemeLength lexeme) + +addContext :: Token -> [Context] -> [Token] -> [Token] + +-- If we see a '{' we add a CtxBrace context +addContext prevToken cs ((_, LexSpecial '{'):ts) = + lay prevToken (CtxBrace : cs) ts + +-- If we see a 'do', 'where', 'of' or 'let' we add a context +-- and a '{' only if the next token is not a '{' +addContext prevToken cs + ((_, LexKeyword keyword):t2@(pos2, lexeme2):ts) + | keyword `elem` ["do", "where", "of","let"] = + if lexeme2 == LexSpecial '{' then + lay prevToken cs (t2:ts) + else + (pos2, LexInsertedOpenBrace) : + lay prevToken + (CtxLay (sourceColumn pos2) (keyword == "let") : cs) + (t2:ts) + | otherwise = + lay prevToken cs (t2:ts) + +addContext prevToken cs (_:ts) = + lay prevToken cs ts + +addContext _ _ [] = [] diff --git a/src/Helium/Parser/Lexer.hs b/src/Helium/Parser/Lexer.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/Lexer.hs @@ -0,0 +1,385 @@ +{-| Module : Lexer + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Parser.Lexer + ( lexer, strategiesLexer + , Token, Lexeme(..) + , lexemeLength + , module Helium.Parser.LexerMessage + ) where + + +import Helium.Main.Args +import Helium.Parser.LexerMonad +import Helium.Parser.LexerMessage +import Helium.Parser.LexerToken +import Text.ParserCombinators.Parsec.Pos +import Helium.Utils.Utils(internalError, hole) + +import Control.Monad(when, liftM) +import Data.Char(ord) +import Data.List(isPrefixOf) + +lexer :: [Option] -> String -> [Char] -> Either LexerError ([Token], [LexerWarning]) +lexer opts fileName input = runLexerMonad opts fileName (mainLexer input) + +strategiesLexer :: [Option] -> String -> [Char] -> Either LexerError ([Token], [LexerWarning]) +strategiesLexer opts fileName input = + case lexer opts fileName input of + Left err -> Left err + Right (tokens, warnings) -> Right (reserveStrategyNames tokens, warnings) + +type Lexer = [Char] -> LexerMonad [Token] + +mainLexer :: Lexer +mainLexer a = + do useTutor <- elem UseTutor `liftM` getOpts + mainLexer' useTutor a + +mainLexer' :: Bool -> Lexer +mainLexer' _ [] = do + checkBracketsAtEOF + pos <- getPos + return [(incSourceLine (setSourceColumn pos 0) 1, LexEOF)] + +mainLexer' _ ('-':'-':cs) + | not (nextCharSatisfy isSymbol rest) = do + incPos (2 + length minuses) + lexOneLineComment rest + where + (minuses, rest) = span (== '-') cs + +mainLexer' useTutor ('{':'-':'#':' ':'M':'U':'S':'T':'U':'S':'E':' ':'#':'-':'}':cs) | useTutor = + returnToken LexMustUse 15 mainLexer cs + +mainLexer' useTutor ('{':'-':'#':' ':'F':'C':cs) | useTutor = do + pos <- getPos + lexCaseFeedbackComment "" pos cs + +mainLexer' useTutor ('{':'-':'#':' ':'F':cs) | useTutor = do + pos <- getPos + incPos 5 + lexFeedbackComment "" pos cs + +mainLexer' _ ('{':'-':cs) = do + pos <- getPos + incPos 2 + lexMultiLineComment [pos] 0 cs + +mainLexer' _ input@('\'':_) = + lexChar input + +mainLexer' _ input@('"':_) = + lexString input + +-- warn if we see something like ".2" +mainLexer' _ ('.':c:cs) + | myIsDigit c = do + pos <- getPos + lexerWarning (LooksLikeFloatNoDigits (takeWhile myIsDigit (c:cs))) pos + returnToken (LexVarSym ".") 1 mainLexer (c:cs) + +mainLexer' useTutor input@(c:cs) + | myIsLower c || c == '_' = -- variable or keyword + lexName isLetter LexVar LexKeyword keywords input + | myIsSpace c = do + when (c == '\t') $ do + pos <- getPos + lexerWarning TabCharacter pos + nextPos c + mainLexer cs + | myIsUpper c = -- constructor + lexName isLetter LexCon (internalError "Lexer" "mainLexer'" "constructor") [] input + | c == ':' = -- constructor operator + lexName isSymbol LexConSym LexResConSym reservedConSyms input + | isSymbol c = -- variable operator + lexName isSymbol LexVarSym LexResVarSym (if useTutor then hole : reservedVarSyms else reservedVarSyms) input + | c `elem` "([{" = do + openBracket c + returnToken (LexSpecial c) 1 mainLexer cs + | c `elem` ")]}" = do + closeBracket c + returnToken (LexSpecial c) 1 mainLexer cs + | c `elem` specialsWithoutBrackets = + returnToken (LexSpecial c) 1 mainLexer cs + | myIsDigit c = -- number + lexIntFloat input + | otherwise = do + pos <- getPos + lexerError (UnexpectedChar c) pos + +lexName :: (Char -> Bool) -> (String -> Lexeme) -> + (String -> Lexeme) -> [String] -> Lexer +lexName predicate normal reserved reserveds cs = do + let (name@(first:_), rest) = span predicate cs + lexeme = if name `elem` reserveds + then reserved name + else normal name + when ((isSymbol first || first == ':') && name `contains` "--") $ do + pos <- getPos + lexerWarning CommentOperator pos + returnToken lexeme (length name) mainLexer rest + +contains :: Eq a => [a] -> [a] -> Bool +[] `contains` _ = False +xs@(_:rest) `contains` ys = ys `isPrefixOf` xs || rest `contains` ys + +----------------------------------------------------------- +-- Numbers +----------------------------------------------------------- + +lexIntFloat :: Lexer +lexIntFloat input = do + _ <- getPos + let (digits, rest) = span myIsDigit input + case rest of + ('.':rest2@(next:_)) + | myIsDigit next -> do + let (fraction, rest3) = span myIsDigit rest2 + prefix = digits ++ "." ++ fraction + lexMaybeExponent prefix LexFloat rest3 + | next /= '.' -> do + pos <- getPos + lexerWarning (LooksLikeFloatNoFraction digits) pos + lexMaybeExponent digits LexInt rest + _ -> + lexMaybeExponent digits LexInt rest + +lexMaybeExponent :: String -> (String -> Lexeme) -> Lexer +lexMaybeExponent prefix lexemeFun input = + case input of + ('e':'+':rest) -> + lexExponent (prefix ++ "e+") rest + ('E':'+':rest) -> + lexExponent (prefix ++ "E+") rest + ('e':'-':rest) -> + lexExponent (prefix ++ "e-") rest + ('E':'-':rest) -> + lexExponent (prefix ++ "E-") rest + ('e':rest) -> + lexExponent (prefix ++ "e") rest + ('E':rest) -> + lexExponent (prefix ++ "E") rest + _ -> + returnToken (lexemeFun prefix) (length prefix) mainLexer input + +lexExponent :: String -> Lexer +lexExponent prefix input = do + startPos <- getPos + let posAtExponent = addPos (length prefix) startPos + (exponentDigits, rest) = span myIsDigit input + if null exponentDigits then + lexerError MissingExponentDigits posAtExponent + else do + let text = prefix ++ exponentDigits + returnToken (LexFloat text) (length text) mainLexer rest + +----------------------------------------------------------- +-- Characters +----------------------------------------------------------- + +lexChar :: Lexer +lexChar input = do + pos <- getPos + case input of + '\'':'\\':c:'\'':cs -> -- '\n' etc + if c `elem` escapeChars then + returnToken (LexChar ['\\',c]) 4 mainLexer cs + else + lexerError IllegalEscapeInChar pos + '\'':'\'':_ -> -- '' + lexerError EmptyChar pos + '\'':c:'\'':cs -> -- 'a' '%' + if ord c >= 32 && ord c <= 126 then + returnToken (LexChar [c]) 3 mainLexer cs + else + lexerError IllegalCharInChar pos + ['\''] -> -- ' at end of file + lexerError EOFInChar pos + ('\'':cs) -> -- if there is a name between single quotes, we give a hint that backquotes might be meant + let (ds, es) = span (/= '\'') cs + ws = words ds + in if not (null es) && head es == '\'' && length ws == 1 && isName (head ws) then + lexerError (NonTerminatedChar (Just (head ws))) pos + else + lexerError (NonTerminatedChar Nothing) pos + _ -> internalError "Lexer" "lexChar" "unexpected characters" + +lexString :: Lexer +lexString ('"':cs) = + lexStringChar "" cs +lexString _ = + internalError "Lexer" "lexString" "should start with \"" + +lexStringChar :: String -> Lexer +lexStringChar revSoFar input = do + startPos <- getPos + let curPos = addPos (length revSoFar + 1) startPos + case input of + [] -> + lexerError EOFInString startPos + '\\':c:cs -> + if c `elem` escapeChars then + lexStringChar (c:'\\':revSoFar) cs + else + lexerError IllegalEscapeInString curPos + '"':cs -> + returnToken (LexString (reverse revSoFar)) + (length revSoFar + 2) mainLexer cs + '\n':_ -> + lexerError NewLineInString startPos + c:cs -> + if ord c >= 32 && ord c <= 126 then + lexStringChar (c:revSoFar) cs + else + lexerError IllegalCharInString curPos + +nextCharSatisfy :: (Char -> Bool) -> String -> Bool +nextCharSatisfy _ [] = False +nextCharSatisfy p (c:_) = p c + +returnToken :: Lexeme -> Int -> Lexer -> Lexer +returnToken lexeme width continue input = do + pos <- getPos + incPos width + let token = (pos, lexeme) + tokens <- continue input + return (token:tokens) + +----------------------------------------------------------- +-- Comment +----------------------------------------------------------- + +lexOneLineComment :: Lexer +lexOneLineComment input = + case input of + [] -> mainLexer [] + ('\n':cs) -> do + nextPos '\n' + mainLexer cs + (c:cs) -> do + nextPos c + lexOneLineComment cs + +lexMultiLineComment :: [SourcePos] -> Int -> Lexer +lexMultiLineComment starts level input = + case input of + '-':'}':cs + | level == 0 -> do + incPos 2 + mainLexer cs + | otherwise -> do + incPos 2 + lexMultiLineComment (tail starts) (level - 1) cs + '{':'-':cs -> do + pos <- getPos + lexerWarning (NestedComment (head starts)) pos + incPos 2 + lexMultiLineComment (pos:starts) (level+1) cs + c:cs -> do + nextPos c + lexMultiLineComment starts level cs + [] -> + lexerError UnterminatedComment (head starts) + -- at end-of-file show the most recently opened comment + +lexFeedbackComment :: String -> SourcePos -> Lexer +lexFeedbackComment feedback start input = + case input of + '#':'-':'}':cs -> + returnToken (LexFeedback (reverse feedback)) + (length feedback + 6) mainLexer cs + c:cs -> do + nextPos c + lexFeedbackComment (c:feedback) start cs + [] -> + lexerError UnterminatedComment start + +lexCaseFeedbackComment :: String -> SourcePos -> Lexer +lexCaseFeedbackComment feedback start input = + case input of + '#':'-':'}':cs -> + returnToken (LexCaseFeedback (reverse feedback)) 0 mainLexer cs + c:cs -> + -- nextPos c + lexCaseFeedbackComment (c:feedback) start cs + [] -> + lexerError UnterminatedComment start +----------------------------------------------------------- +-- Utility functions +----------------------------------------------------------- + +isSymbol :: Char -> Bool +isSymbol = (`elem` symbols) + +isLetter :: Char -> Bool +isLetter '\'' = True +isLetter '_' = True +isLetter c = myIsAlphaNum c + +-- write our own isLower.. so that we don't accept funny symbols +myIsLower :: Char -> Bool +myIsLower c = c >= 'a' && c <= 'z' + +myIsUpper :: Char -> Bool +myIsUpper c = c >= 'A' && c <= 'Z' + +myIsDigit :: Char -> Bool +myIsDigit c = c >= '0' && c <= '9' + +myIsAlphaNum :: Char -> Bool +myIsAlphaNum c = myIsLower c || myIsUpper c || myIsDigit c + +myIsSpace :: Char -> Bool +myIsSpace c = c == ' ' || c == '\n' || c == '\t' || c == '\r' + +isName :: String -> Bool +isName [] = False +isName (hd:tl) = (myIsUpper hd || myIsLower hd) && all isLetter tl + +----------------------------------------------------------- +-- Constants +----------------------------------------------------------- + +escapeChars :: String +escapeChars = "\\nabfnrtv\"'" + +symbols :: String +symbols = "!#$%&*+./<=>?@^|-~:\\" + +keywords :: [String] +keywords = + [ "let", "in", "do", "where", "case", "of", "if" + , "then", "else", "data", "type", "module", "import", "hiding" + , "infix", "infixl", "infixr", "_", "deriving" + , "class", "instance", "default", "newtype" -- not supported + ] + +reservedConSyms :: [String] +reservedConSyms = + [ "::" ] + +reservedVarSyms :: [String] +reservedVarSyms = + [ "=>", "->", "<-", "..", "-", "-.", "@", "=", "\\", "|", "~" ] + +specialsWithoutBrackets :: String +specialsWithoutBrackets = + ",`;" + +reserveStrategyNames :: [Token] -> [Token] +reserveStrategyNames = + map (\token@(pos, lexeme) -> case lexeme of + LexVar s | s `elem` strategiesKeywords -> (pos, LexKeyword s) + LexVarSym s | s == "==" -> (pos, LexResVarSym s) + LexConSym s | s == ":" -> (pos, LexResConSym s) + _ -> token + ) + +strategiesKeywords :: [String] +strategiesKeywords = [ "phase", "constraints", "siblings" ] diff --git a/src/Helium/Parser/LexerMessage.hs b/src/Helium/Parser/LexerMessage.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/LexerMessage.hs @@ -0,0 +1,149 @@ +{-| Module : LexerMessage + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Parser.LexerMessage + ( LexerError(..) + , LexerErrorInfo(..) + , LexerWarning(..) + , LexerWarningInfo(..) + , keepOneTabWarning + , isLooksLikeFloatWarningInfo + ) where + +import Text.ParserCombinators.Parsec.Pos +import Helium.Syntax.UHA_Syntax(Range(..), Position(..)) +import Helium.StaticAnalysis.Messages.Messages +import qualified Helium.Utils.Texts as Texts + +instance HasMessage LexerError where + getRanges (LexerError _ (StillOpenAtEOF brackets)) = + reverse (map (sourcePosToRange . fst) brackets) + getRanges (LexerError pos (UnexpectedClose _ pos2 _)) = + map sourcePosToRange [pos, pos2] + getRanges (LexerError pos _) = + [ sourcePosToRange pos ] + getMessage (LexerError _ info) = + let (line:rest) = showLexerErrorInfo info + in MessageOneLiner (MessageString line) : + [ MessageHints Texts.hint [ MessageString s | s <- rest ] ] + +sourcePosToRange :: SourcePos -> Range +sourcePosToRange pos = + let name = sourceName pos; line = sourceLine pos; col = sourceColumn pos + position = Position_Position name line col + in Range_Range position position + +data LexerError = + LexerError SourcePos LexerErrorInfo + +data LexerErrorInfo + = UnterminatedComment + | MissingExponentDigits + | UnexpectedChar Char + + | IllegalEscapeInChar + | EmptyChar + | IllegalCharInChar + | NonTerminatedChar (Maybe String) + | EOFInChar + + | EOFInString + | IllegalEscapeInString + | NewLineInString + | IllegalCharInString + + | TooManyClose Char + -- In UnexpectedClose, first char is the closing bracket we see, + -- second char is the closing bracket we would like to see first + -- e.g. [(1,3] => UnexpectedClose ']' ... ')' + | UnexpectedClose Char SourcePos Char + | StillOpenAtEOF [(SourcePos, Char)] + +showLexerErrorInfo :: LexerErrorInfo -> [String] +showLexerErrorInfo info = + case info of + UnterminatedComment -> [ Texts.lexerUnterminatedComment ] + MissingExponentDigits -> [ Texts.lexerMissingExponentDigits + , correctFloats + ] + UnexpectedChar c -> [ Texts.lexerUnexpectedChar c ] + + IllegalEscapeInChar -> [ Texts.lexerIllegalEscapeInChar, correctChars ] + EmptyChar -> [ Texts.lexerEmptyChar, correctChars ] + IllegalCharInChar -> [ Texts.lexerIllegalCharInChar, correctChars ] + NonTerminatedChar mn -> + [ Texts.lexerNonTerminatedChar + , correctChars + ] ++ case mn of + Nothing -> [] + Just name -> [ Texts.lexerInfixHint name ] + EOFInChar -> [ Texts.lexerEOFInChar, correctChars] + + EOFInString -> [ Texts.lexerEOFInString, correctStrings ] + IllegalEscapeInString -> [ Texts.lexerIllegalEscapeInString, correctStrings ] + NewLineInString -> [ Texts.lexerNewLineInString, correctStrings ] + IllegalCharInString -> [ Texts.lexerIllegalCharInString, correctStrings] + + TooManyClose c -> [ Texts.lexerTooManyClose c ] + UnexpectedClose c1 _ c2 -> Texts.lexerUnexpectedClose c1 c2 + StillOpenAtEOF [b] -> [ Texts.lexerStillOpenAtEOF [ show (snd b) ] ] + StillOpenAtEOF bs -> [ Texts.lexerStillOpenAtEOF (reverse (map (show.snd) bs)) ] + -- 'reverse' because positions will be sorted and brackets are + -- reported in reversed order + +correctFloats, correctChars, correctStrings :: String +correctFloats = Texts.lexerCorrectFloats +correctChars = Texts.lexerCorrectChars +correctStrings = Texts.lexerCorrectStrings + +instance HasMessage LexerWarning where + getRanges (LexerWarning pos (NestedComment pos2)) = + map sourcePosToRange [ pos, pos2 ] + getRanges (LexerWarning pos _) = + [ sourcePosToRange pos ] + getMessage (LexerWarning _ info) = + let (line:rest) = showLexerWarningInfo info + in MessageOneLiner (MessageString (Texts.warning ++ ": " ++ line)) : + [ MessageHints Texts.hint [ MessageString s | s <- rest ] ] + +data LexerWarning = + LexerWarning SourcePos LexerWarningInfo + +data LexerWarningInfo + = TabCharacter + | LooksLikeFloatNoFraction String + | LooksLikeFloatNoDigits String + | NestedComment SourcePos + | CommentOperator + +showLexerWarningInfo :: LexerWarningInfo -> [String] +showLexerWarningInfo info = + case info of + TabCharacter -> Texts.lexerTabCharacter + LooksLikeFloatNoFraction digits -> Texts.lexerLooksLikeFloatNoFraction digits + LooksLikeFloatNoDigits fraction -> Texts.lexerLooksLikeFloatNoDigits fraction + NestedComment _ -> Texts.lexerNestedComment + CommentOperator -> Texts.lexerCommentOperator + + +keepOneTabWarning :: [LexerWarning] -> [LexerWarning] +keepOneTabWarning = keepOneTab True + where + keepOneTab isFirst (warning@(LexerWarning _ TabCharacter):rest) + | isFirst = warning : keepOneTab False rest + | otherwise = keepOneTab isFirst rest + keepOneTab isFirst (warning:rest) = + warning : keepOneTab isFirst rest + keepOneTab _ [] = [] + +isLooksLikeFloatWarningInfo :: LexerWarningInfo -> Bool +isLooksLikeFloatWarningInfo warningInfo = + case warningInfo of + LooksLikeFloatNoFraction _ -> True + LooksLikeFloatNoDigits _ -> True + _ -> False diff --git a/src/Helium/Parser/LexerMonad.hs b/src/Helium/Parser/LexerMonad.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/LexerMonad.hs @@ -0,0 +1,108 @@ +{-| Module : LexerMonad + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Parser.LexerMonad + ( LexerMonad + , getPos, incPos, nextPos, addPos + , openBracket, closeBracket, checkBracketsAtEOF + , lexerError, lexerWarning + , runLexerMonad + , getOpts + ) where + +import Helium.Main.Args +import Helium.Parser.LexerMessage +import Text.ParserCombinators.Parsec.Pos + +type Bracket = (SourcePos, Char) + +-- Output monad: [LexerWarning] +-- State monad: SourcePos and [Bracket] +newtype LexerMonad a = + LM ([Option] -> SourcePos -> [Bracket] -> + Either LexerError (a, [LexerWarning], SourcePos, [Bracket])) + +unLM :: LexerMonad t -> [Option] -> SourcePos -> [Bracket] + -> Either LexerError (t, [LexerWarning], SourcePos, [Bracket]) +unLM (LM x) = x + +bindLM :: LexerMonad a -> (a -> LexerMonad b) -> LexerMonad b +bindLM (LM f) g = + LM (\opts pos brackets -> + case f opts pos brackets of + Left err -> Left err + Right (a, warnings, pos2, brackets2) -> + case unLM (g a) opts pos2 brackets2 of + Left err -> Left err + Right (b, moreWarnings, pos3, brackets3) -> + Right (b, warnings ++ moreWarnings, pos3, brackets3)) + +returnLM :: a -> LexerMonad a +returnLM x = LM (\_ pos brackets -> Right (x, [], pos, brackets)) + +instance Monad LexerMonad where + (>>=) = bindLM + return = returnLM + +runLexerMonad :: [Option] -> String -> LexerMonad a -> Either LexerError (a, [LexerWarning]) +runLexerMonad opts fileName (LM f) = + case f opts (initialPos fileName) [] of + Left err -> Left err + Right (a, warnings, _, _) -> Right (a, keepOneTabWarning warnings) + +getOpts :: LexerMonad [Option] +getOpts = LM (\opts pos brackets -> Right (opts, [], pos, brackets)) + +getPos :: LexerMonad SourcePos +getPos = LM (\_ pos brackets -> Right (pos, [], pos, brackets)) + +incPos :: Int -> LexerMonad () +incPos i = LM (\_ pos brackets -> Right ((), [], addPos i pos, brackets)) + +nextPos :: Char -> LexerMonad () +nextPos c = LM (\_ pos brackets -> Right ( (), [], updatePosChar pos c, brackets )) + +lexerError :: LexerErrorInfo -> SourcePos -> LexerMonad a +lexerError err pos = + LM (\_ _ _ -> Left (LexerError pos err)) + +lexerWarning :: LexerWarningInfo -> SourcePos -> LexerMonad () +lexerWarning warning warningPos = + LM (\_ pos brackets -> + Right ((), [LexerWarning warningPos warning], pos, brackets)) + +addPos :: Int -> SourcePos -> SourcePos +addPos i pos = incSourceColumn pos i + +openBracket :: Char -> LexerMonad () +openBracket c = LM (\_ pos brackets -> + Right ( (), [], pos, (pos, c) : brackets )) + +closeBracket :: Char -> LexerMonad () +closeBracket c = LM (\_ pos brackets -> + case brackets of + [] -> Left (LexerError pos (TooManyClose c)) + (pos2, c2):rest + | matchBracket c2 c -> + Right ((), [], pos, rest) + | otherwise -> + Left (LexerError pos (UnexpectedClose c pos2 c2)) + ) + +checkBracketsAtEOF :: LexerMonad () +checkBracketsAtEOF = LM (\_ pos brackets -> + case brackets of + [] -> Right ((), [], pos, []) + _ -> Left (LexerError pos (StillOpenAtEOF brackets)) + ) + +matchBracket :: Char -> Char -> Bool +matchBracket '(' ')' = True +matchBracket '[' ']' = True +matchBracket '{' '}' = True +matchBracket _ _ = False diff --git a/src/Helium/Parser/LexerToken.hs b/src/Helium/Parser/LexerToken.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/LexerToken.hs @@ -0,0 +1,88 @@ +{-| Module : LexerToken + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Parser.LexerToken where + +import Text.ParserCombinators.Parsec.Pos(SourcePos) +import qualified Helium.Utils.Texts as Texts + +type Token = (SourcePos,Lexeme) + +data Lexeme + = LexChar String + | LexString String + | LexInt String + | LexFloat String + + | LexVar String + | LexVarSym String + | LexCon String + | LexConSym String + + | LexKeyword String + | LexResVarSym String + | LexResConSym String + | LexSpecial Char + + | LexFeedback String + | LexCaseFeedback String + | LexMustUse + | LexHole + + | LexInsertedOpenBrace -- { inserted because of layout + | LexInsertedCloseBrace -- } + | LexInsertedSemicolon -- ; + + | LexEOF + deriving Eq + +instance Show Lexeme where + show x = case x of + LexChar c -> Texts.parserCharacterLiteral ++ " '" ++ c ++ "'" + LexString s -> Texts.parserStringLiteral ++ " \""++ s ++ "\"" + LexInt i -> Texts.parserIntegerLiteral ++ " '" ++ i ++ "'" + LexFloat f -> Texts.parserFloatLiteral ++ " '" ++ f ++ "'" + + LexVar n -> Texts.parserVariable ++ " '" ++ n ++ "'" + LexVarSym o -> Texts.parserOperator ++ " '" ++ o ++ "'" + LexCon c -> Texts.parserConstructor ++ " '" ++ c ++ "'" + LexConSym o -> Texts.parserConstructorOperator ++ " '" ++ o ++ "'" + + LexKeyword kwd -> Texts.parserKeyword ++ " '" ++ kwd ++ "'" + LexResVarSym s -> "'" ++ s ++ "'" + LexResConSym s -> "'" ++ s ++ "'" + LexSpecial c -> "'" ++ [c] ++ "'" + + LexFeedback f -> "Feedback \"" ++ f ++ "\"" + LexCaseFeedback f -> "Case feedback \"" ++ f ++ "\"" + LexMustUse -> "Must Use" + LexHole -> "Hole" + + LexInsertedOpenBrace -> Texts.parserInsertedLBrace + LexInsertedCloseBrace -> Texts.parserEndOfBlock + LexInsertedSemicolon -> Texts.parserNextInBlock + + LexEOF -> Texts.parserEndOfFile + +lexemeLength :: Lexeme -> Int +lexemeLength l = case l of + LexChar s -> length s + 2 -- count the quotes, too + LexString s -> length s + 2 + LexInt s -> length s + LexFloat s -> length s + + LexVar s -> length s + LexVarSym s -> length s + LexCon s -> length s + LexConSym s -> length s + + LexSpecial _ -> 1 + LexKeyword s -> length s + LexResVarSym s -> length s + LexResConSym s -> length s + _ -> 0 diff --git a/src/Helium/Parser/OperatorTable.hs b/src/Helium/Parser/OperatorTable.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/OperatorTable.hs @@ -0,0 +1,47 @@ +{-| Module : OperatorTable + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Parser.OperatorTable + ( Assoc(..) + , OperatorTable + , assoc, prio + ) where + +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils () +import qualified Data.Map as M + +type OperatorTable = M.Map Name (Int, Assoc) + +-- From ParsecExpr +data Assoc = AssocNone + | AssocLeft + | AssocRight + +assoc :: OperatorTable -> Name -> Assoc +assoc ops name = + case M.lookup name ops of + Nothing -> AssocLeft -- default associativity, if unspecified + Just (_, a) -> a + +prio :: OperatorTable -> Name -> Int +prio ops name = + case M.lookup name ops of + Nothing -> 9 -- default priority, if unspecified + Just (p, _) -> p + +instance Eq Assoc where + AssocLeft == AssocLeft = True + AssocRight == AssocRight = True + AssocNone == AssocNone = True + _ == _ = False + +instance Show Assoc where + show AssocNone = "infix" + show AssocLeft = "infixl" + show AssocRight = "infixr" diff --git a/src/Helium/Parser/ParseLibrary.hs b/src/Helium/Parser/ParseLibrary.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/ParseLibrary.hs @@ -0,0 +1,318 @@ +{-| Module : ParseLibrary + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Parser.ParseLibrary where + +import Text.ParserCombinators.Parsec hiding (satisfy) +import Text.ParserCombinators.Parsec.Pos(newPos) +import Data.Functor.Identity (Identity) +import Text.Parsec.Prim (ParsecT) +import Helium.Parser.Lexer +import Helium.Utils.Utils (hole) +import Helium.Syntax.UHA_Syntax(Name(..), Range(..), Position(..)) +import qualified Helium.Utils.Texts as Texts + + +type HParser a = GenParser Token SourcePos a + +runHParser :: HParser a -> FilePath -> [Token] -> Bool -> Either ParseError a +runHParser p fname theTokens withEOF = + runParser + (if withEOF then waitForEOF p else p) + (newPos fname 0 0) + fname + theTokens + +waitForEOF :: ParsecT [Token] SourcePos Identity b + -> ParsecT [Token] SourcePos Identity b +waitForEOF p + = do{ x <- p + ; lexeme LexEOF + ; return x + } + +tycls, tycon, tyvar, modid, varid, conid, consym, varsym :: ParsecT [Token] SourcePos Identity Name +tycls = name lexCon Texts.parserTypeClass +tycon = name lexCon Texts.parserTypeConstructor +tyvar = name lexVar Texts.parserTypeVariable +modid = name lexCon Texts.parserModuleName +varid = name lexVar Texts.parserVariable +conid = name lexCon Texts.parserVariable +consym = opName lexConSym + Texts.parserOperator +varsym = opName ( lexVarSym + <|> do { lexMIN; return "-" } + <|> do { lexMINDOT; return "-." } + ) + Texts.parserOperator + +-- var -> varid | ( varsym ) (variable) +var :: ParsecT [Token] SourcePos Identity Name +var = varid <|> parens varsym + Texts.parserVariable + +-- con -> conid | ( consym ) (constructor) +con :: ParsecT [Token] SourcePos Identity Name +con = conid <|> parens consym + Texts.parserVariable + +-- op -> varop | conop (operator) +-- expanded for better parse errors +op :: ParsecT [Token] SourcePos Identity Name +op = varsym <|> consym <|> lexBACKQUOTEs (varid <|> conid) + Texts.parserOperator + +-- varop -> varsym | `varid ` (variable operator) +varop :: ParsecT [Token] SourcePos Identity Name +varop = varsym <|> lexBACKQUOTEs varid + Texts.parserOperator + +-- conop -> consym | `conid ` (constructor operator) +conop :: ParsecT [Token] SourcePos Identity Name +conop = consym <|> lexBACKQUOTEs conid + Texts.parserOperator + +name :: HParser String -> HParser Name +name p = addRange $ + do + n <- p + return (\r -> Name_Identifier r [] n) -- !!!Name + +opName :: HParser String -> HParser Name +opName p = addRange $ + do + n <- p + return (\r -> Name_Operator r [] n) -- !!!Name + +addRange :: HParser (Range -> a) -> HParser a +addRange p = + do + start <- getPosition + f <- p + end <- getLastPosition + let r = Range_Range (sourcePosToPosition start) (sourcePosToPosition end) + return (f r) + +withRange :: HParser a -> HParser (a, Range) +withRange p = addRange (do { x <- p; return (\r -> (x, r)); }) + +sourcePosToPosition :: SourcePos -> Position +sourcePosToPosition sourcePos = + Position_Position + (sourceName sourcePos) + (sourceLine sourcePos) + (sourceColumn sourcePos) + +lexBACKQUOTEs, brackets :: ParsecT [Token] SourcePos Identity a + -> ParsecT [Token] SourcePos Identity a +lexBACKQUOTEs = between lexBACKQUOTE lexBACKQUOTE +brackets = between lexLBRACKET lexRBRACKET + +commas, commas1 :: ParsecT [Token] SourcePos Identity a + -> ParsecT [Token] SourcePos Identity [a] +commas p = p `sepBy` lexCOMMA +commas1 p = p `sepBy1` lexCOMMA + + + +lexINSERTED_SEMI, lexINSERTED_LBRACE, lexINSERTED_RBRACE:: HParser() +lexINSERTED_SEMI = lexeme LexInsertedSemicolon +lexINSERTED_LBRACE = lexeme LexInsertedOpenBrace +lexINSERTED_RBRACE = lexeme LexInsertedCloseBrace + +lexLBRACE, lexRBRACE, lexLPAREN, lexRPAREN, lexLBRACKET,lexRBRACKET, lexCOMMA, lexSEMI, lexBACKQUOTE :: HParser () +lexLBRACE = lexeme (LexSpecial '{') +lexRBRACE = lexeme (LexSpecial '}') +lexLPAREN = lexeme (LexSpecial '(') +lexRPAREN = lexeme (LexSpecial ')') +lexLBRACKET = lexeme (LexSpecial '[') +lexRBRACKET = lexeme (LexSpecial ']') +lexCOMMA = lexeme (LexSpecial ',') +lexSEMI = lexeme (LexSpecial ';') +lexBACKQUOTE = lexeme (LexSpecial '`') + +lexHOLE :: HParser () +lexHOLE = lexeme (LexResVarSym hole) + + +lexASG, lexLARROW, lexRARROW, lexDARROW, lexBAR, lexMIN, lexMINDOT, lexBSLASH, lexAT, lexDOTDOT, lexTILDE :: HParser () +lexASG = lexeme (LexResVarSym "=") +lexLARROW = lexeme (LexResVarSym "<-") +lexRARROW = lexeme (LexResVarSym "->") +lexDARROW = lexeme (LexResVarSym "=>") +lexBAR = lexeme (LexResVarSym "|") +lexMIN = lexeme (LexResVarSym "-") +lexMINDOT = lexeme (LexResVarSym "-.") +lexBSLASH = lexeme (LexResVarSym "\\") +lexAT = lexeme (LexResVarSym "@") +lexDOTDOT = lexeme (LexResVarSym "..") +lexTILDE = lexeme (LexResVarSym "~") + +lexCOLCOL :: HParser () +lexCOLCOL = lexeme (LexResConSym "::") + +lexCLASS, lexDATA, lexDERIVING, lexTYPE, lexLET, lexIN, lexDO, lexIF, lexTHEN, lexELSE, lexCASE, lexOF, lexMODULE, lexWHERE, lexIMPORT, lexHIDING, lexINFIX, lexINFIXL, lexINFIXR, lexUNDERSCORE :: HParser () +lexCLASS = lexeme (LexKeyword "class") +lexDATA = lexeme (LexKeyword "data") +lexDERIVING = lexeme (LexKeyword "deriving") +lexTYPE = lexeme (LexKeyword "type") +lexLET = lexeme (LexKeyword "let") +lexIN = lexeme (LexKeyword "in") +lexDO = lexeme (LexKeyword "do") +lexIF = lexeme (LexKeyword "if") +lexTHEN = lexeme (LexKeyword "then") +lexELSE = lexeme (LexKeyword "else") +lexCASE = lexeme (LexKeyword "case") +lexOF = lexeme (LexKeyword "of") +lexMODULE = lexeme (LexKeyword "module") +lexWHERE = lexeme (LexKeyword "where") +lexIMPORT = lexeme (LexKeyword "import") +lexHIDING = lexeme (LexKeyword "hiding") +lexINFIX = lexeme (LexKeyword "infix") +lexINFIXL = lexeme (LexKeyword "infixl") +lexINFIXR = lexeme (LexKeyword "infixr") +lexUNDERSCORE = lexeme (LexKeyword "_") + + +-- Typing strategies +lexPHASE, lexCONSTRAINTS, lexSIBLINGS, lexCOL, lexASGASG :: HParser () +lexPHASE = lexeme (LexKeyword "phase") +lexCONSTRAINTS = lexeme (LexKeyword "constraints") +lexSIBLINGS = lexeme (LexKeyword "siblings") +lexCOL = lexeme (LexResConSym ":") +lexASGASG = lexeme (LexResVarSym "==") + +{- +Expressions and patterns with operators are represented by lists. The Range +of this list is 'noRange' (a range with two unknown positions). The post-processor +recognises this and will build infix applications out of the list. +The list itself contains expressions (/patterns) and operators. Operators can +be recognised because they also have noRange. Their name, however, does have a range. +The unary minus has 'unaryMinus' as its name to distinguish it from the binary minus. + +An example, "-3+4" is parsed as: + +Expression_List <,> + [ Expression_Variable <,> (Name_Identifier <<1,1>,<1,2>> [] "unaryMinus") + , Expression_Literal <<1,2>,<1,3>> (Literal_Int <<1,2>,<1,3>> "3") + , Expression_Variable <,> (Name_Identifier <<1,3>,<1,4>> [] "+") + , Expression_Literal <<1,4>,<1,5>> (Literal_Int <<1,4>,<1,5>> "4") + ] + +-} + +---------------------------------------------------------------- +-- Extra parser combinators +---------------------------------------------------------------- + +withLayout, withLayout1 ::ParsecT [Token] SourcePos Identity a + -> ParsecT [Token] SourcePos Identity [a] +withLayout p = + withBraces (semiSepTerm p) (semiOrInsertedSemiSepTerm p) + +withLayout1 p = + withBraces (semiSepTerm1 p) (semiOrInsertedSemiSepTerm1 p) + +withBraces' :: (Bool -> ParsecT [Token] SourcePos Identity a) + -> ParsecT [Token] SourcePos Identity a +withBraces' p = + withBraces (p True) (p False) + +withBraces :: ParsecT [Token] SourcePos Identity a + -> ParsecT [Token] SourcePos Identity a + -> ParsecT [Token] SourcePos Identity a +withBraces p1 p2 = + do + lexLBRACE + x <- p1 + lexRBRACE + return x + <|> + do + lexINSERTED_LBRACE + x <- p2 + lexINSERTED_RBRACE + return x + +semiSepTerm1, semiSepTerm, semiOrInsertedSemiSepTerm1, semiOrInsertedSemiSepTerm :: ParsecT [Token] SourcePos Identity a + -> ParsecT [Token] SourcePos Identity [a] +semiSepTerm1 p = p `sepEndBy1` lexSEMI +semiSepTerm p = p `sepEndBy` lexSEMI +semiOrInsertedSemiSepTerm1 p = p `sepEndBy1` (lexINSERTED_SEMI <|> lexSEMI) +semiOrInsertedSemiSepTerm p = p `sepEndBy` (lexINSERTED_SEMI <|> lexSEMI) + +parens, braces :: ParsecT [Token] SourcePos Identity a + -> ParsecT [Token] SourcePos Identity a +parens = between lexLPAREN lexRPAREN +braces = between lexLBRACE lexRBRACE + +---------------------------------------------------------------- +-- Basic parsers +---------------------------------------------------------------- + +lexeme :: Lexeme -> HParser () +lexeme theLexeme + = satisfy (\lex' -> if theLexeme == lex' then Just () else Nothing) show theLexeme + + +lexChar :: HParser String +lexChar + = satisfy (\lex' -> case lex' of { LexChar c -> Just c; _ -> Nothing }) + +lexString :: HParser String +lexString + = satisfy (\lex' -> case lex' of { LexString s -> Just s; _ -> Nothing }) + +lexDouble :: HParser String +lexDouble + = satisfy (\lex' -> case lex' of { LexFloat d -> Just d; _ -> Nothing }) + +lexInt :: HParser String +lexInt + = satisfy (\lex' -> case lex' of { LexInt i -> Just i; _ -> Nothing }) + +lexVar :: HParser String +lexVar + = satisfy (\lex' -> case lex' of { LexVar s -> Just s; _ -> Nothing }) + +lexCon :: HParser String +lexCon + = satisfy (\lex' -> case lex' of { LexCon s -> Just s; _ -> Nothing }) + +lexVarSym :: HParser String +lexVarSym + = satisfy (\lex' -> case lex' of { LexVarSym s -> Just s; _ -> Nothing }) + +lexConSym :: HParser String +lexConSym + = satisfy (\lex' -> case lex' of { LexConSym s -> Just s; _ -> Nothing }) + +lexFeedback :: HParser String +lexFeedback + = satisfy (\lex' -> case lex' of { LexFeedback s -> Just s; _ -> Nothing }) + +lexCaseFeedback :: HParser String +lexCaseFeedback + = satisfy (\lex' -> case lex' of { LexCaseFeedback s -> Just s; _ -> Nothing }) + +satisfy :: (Lexeme -> Maybe a) -> HParser a +satisfy predicate + = tokenPrimEx + showtok + nextpos + (Just (\_ (pos,lex') _ _ -> incSourceColumn pos (lexemeLength lex'))) + (\(_,lex') -> predicate lex') + where + showtok (_,lex') = show lex' + nextpos _ _ ((pos,_):_) + = pos + nextpos pos _ [] + = pos + +getLastPosition :: HParser SourcePos +getLastPosition = getState diff --git a/src/Helium/Parser/ParseMessage.hs b/src/Helium/Parser/ParseMessage.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/ParseMessage.hs @@ -0,0 +1,39 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| Module : ParseMessage + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Parser.ParseMessage() where + +import Helium.StaticAnalysis.Messages.Messages hiding (Message) +import Helium.Syntax.UHA_Syntax(Range(..), Position(..)) +import qualified Helium.Utils.Texts as Texts + +import Text.ParserCombinators.Parsec.Error +import Text.ParserCombinators.Parsec.Pos + +instance HasMessage ParseError where + getMessage pe = + let msgs = errorMessages pe in + MessageOneLiner (MessageString (Texts.parserSyntaxError ++ ": ")) : + map (MessageOneLiner . MessageString . (" "++)) ( + ( filter (not . null) + . lines + . showErrorMessages + Texts.parserOr + Texts.parserUnknown + Texts.parserExpecting + Texts.parserUnexpected + Texts.parserEndOfInput + ) msgs + ) + getRanges parseError = + let pos = errorPos parseError + name = sourceName pos; line = sourceLine pos; col = sourceColumn pos + position = Position_Position name line col + in [ Range_Range position position ] + diff --git a/src/Helium/Parser/Parser.hs b/src/Helium/Parser/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/Parser.hs @@ -0,0 +1,1184 @@ +{-| Module : Parser + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Parser.Parser + ( module_, exp_, exp0, type_, atype, contextAndType + , parseOnlyImports + ) where + +{- +Absent: +- records +- classes (class, instance, default...) +- "newtype" +- strictness annotations +- n+k patterns +- [] and (,) and (,,,) etc as (type) constructor +- empty declarations, qualifiers, alternatives or statements +- "qualified", "as" in imports +- import and export lists + +Simplified: +- funlhs + For example x:xs +++ ys = ... is not allowed, parentheses around x:xs necessary +- pattern binding met pat10 i.p.v. pat0 + For example (x:xs) = [1..] (parenthesis are obligatory) +- sections: (fexp op) and (op fexp) + For example (+2*3) is not allowed, should be (+(2*3)) +- fixity declarations only at top-level +-} + +import Control.Monad +import qualified Control.Exception as CE (catch, IOException) +import Helium.Parser.ParseLibrary hiding (satisfy) +import Data.Functor.Identity (Identity) +import Text.ParserCombinators.Parsec +import Text.Parsec.Prim (ParsecT) +import Helium.Parser.Lexer +import Helium.Parser.LayoutRule +import qualified Helium.Utils.Texts as Texts + +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils +import Helium.Syntax.UHA_Range + +import qualified Helium.Parser.CollectFunctionBindings as CollectFunctionBindings +import Helium.Utils.Utils + +parseOnlyImports :: String -> IO [String] +parseOnlyImports fullName = do + contents <- CE.catch (readFile fullName) + (\ioErr -> + let message = "Unable to read file " ++ show fullName + ++ " (" ++ show (ioErr :: CE.IOException) ++ ")" + in throw message) + + return $ case lexer [] fullName contents of + Left _ -> [] + Right (toks, _) -> + case runHParser onlyImports fullName (layout toks) False {- no EOF -} of + Left _ -> [] + Right imports -> + map stringFromImportDeclaration imports + +{- +module + -> "module" modid exports? "where" body +-- | body +-} + +module_ :: HParser Module +module_ = addRange $ + do + lexMODULE + n <- modid + let mes = MaybeExports_Nothing + lexWHERE + b <- body + return (\r -> Module_Module r (MaybeName_Just n) mes b) + <|> + do + b <- body + return (\r -> + Module_Module r MaybeName_Nothing MaybeExports_Nothing b) + + +onlyImports :: HParser [ImportDeclaration] +onlyImports = + do + lexMODULE + _ <- modid + let _ = MaybeExports_Nothing + lexWHERE + lexLBRACE <|> lexINSERTED_LBRACE + many (do { i <- impdecl; semicolon; return i }) + <|> + do + lexLBRACE <|> lexINSERTED_LBRACE + many (do { i <- impdecl; semicolon; return i }) + where + semicolon = lexSEMI <|> lexINSERTED_SEMI <|> lexINSERTED_RBRACE + -- the last of the three is a hack to support files that + -- only contain imports + +{- +body -> "{" topdecls "}" +topdecls -> topdecl1 ";" ... ";" topdecln (n>=0) +-} + +body :: HParser Body +body = addRange $ + withBraces' $ \explicit -> + do + lexHOLE + return (\r -> Body_Hole r 0) + <|> + do + (is, ds) <- importsThenTopdecls explicit + let groupedDecls = CollectFunctionBindings.decls ds + return $ \r -> Body_Body r is groupedDecls + +importsThenTopdecls :: Bool -> + ParsecT [Token] SourcePos Identity ([ImportDeclaration], [Declaration]) +importsThenTopdecls explicit = + do + is <- many (do { i <- impdecl + ; if explicit then lexSEMI else lexSEMI <|> lexINSERTED_SEMI + ; return i + } ) + ds <- topdeclCombinator topdecl + return (is, ds) + + where + topdeclCombinator = if explicit then semiSepTerm else semiOrInsertedSemiSepTerm + + + +{- +topdecl + -> impdecl + | "data" simpletype "=" constrs derivings? + | "type" simpletype "=" type + | infixdecl + | decl + +derivings + -> "deriving" derivings' + +derivings' + -> tycon + | "(" ")" + | "(" tycon ( "," tycon )* ")" + +simpletype + -> tycon tyvar1 ... tyvark (k>=0) +-} + +{- + | Data + range : Range + context : ContextItems + simpletype : SimpleType + constructors : Constructors + derivings : Names +-} + +topdecl :: HParser Declaration +topdecl = addRange ( + do + lexDATA + st <- simpleType + lexASG + cs <- constrs + ds <- option [] derivings + return (\r -> Declaration_Data r [] st cs ds) + <|> + do + lexTYPE + st <- simpleType + lexASG + t <- type_ + return $ \r -> Declaration_Type r st t + <|> + infixdecl + ) + <|> addRange ( + do + lexHOLE + jb <- optionMaybe normalRhs + case jb of + Just b -> return $ \r -> Declaration_PatternBinding r (Pattern_Hole r (-1)) b + Nothing -> return $ \r -> Declaration_Hole r (-1) + ) + <|> + decl + Texts.parserDeclaration + +derivings :: HParser [Name] +derivings = + do lexDERIVING + ( do cls <- tycls + return [cls] ) + <|> ( + do lexLPAREN + clss <- tycls `sepBy` lexCOMMA + lexRPAREN + return clss ) + +simpleType :: HParser SimpleType +simpleType = + addRange ( + do + c <- tycon + vs <- many tyvar + return $ \r -> SimpleType_SimpleType r c vs + ) + +{- +infixdecl -> fixity [digit] ops (fixity declaration) +fixity -> "infixl" | "infixr" | "infix" +ops -> op1 "," ... "," opn (n>=1) +-} + +infixdecl :: HParser (Range -> Declaration) +infixdecl = + do + f <- fixity + p <- fmap fromInteger (option 9 (fmap read lexInt)) :: HParser Int + when (p < 0 || p > 9) (fail Texts.parserSingleDigitPriority) + os <- ops + return $ \r -> Declaration_Fixity r f (MaybeInt_Just p) os + +ops :: HParser Names +ops = commas1 op + +fixity :: HParser Fixity +fixity = addRange $ + do + lexINFIXL + return $ \r -> Fixity_Infixl r + <|> + do + lexINFIXR + return $ \r -> Fixity_Infixr r + <|> + do + lexINFIX + return $ \r -> Fixity_Infix r + +{- +constrs -> constr1 "|" ... "|" constrn (n>=1) +-} + +constrs :: HParser Constructors +constrs = constr `sepBy1` lexBAR + +{- +constr -> btype conop btype (infix conop) + | con atype1 ... atypek (arity con = k, k>=0) +-} + +constr :: HParser Constructor +constr = addRange $ + do + (t1, n) <- try $ do + t1 <- annotatedType btype + n <- conop + return (t1, n) + t2 <- annotatedType btype + return (\r -> Constructor_Infix r t1 n t2) + <|> + do + n <- con + ts <- many (annotatedType atype) + return (\r -> Constructor_Constructor r n ts) + + +{- +Simplified import: +impdecl -> "import" modid impspec? +impspec -> "hiding" "(" import "," ... ")" +import -> var +-} + +impdecl :: HParser ImportDeclaration +impdecl = addRange ( + do + lexIMPORT + let q = False + m <- modid + let a = MaybeName_Nothing + i <- option MaybeImportSpecification_Nothing $ + do{ is <- impspec + ; return (MaybeImportSpecification_Just is) + } + return $ \r -> ImportDeclaration_Import r q m a i + ) Texts.parserImportDeclaration + +impspec :: HParser ImportSpecification +impspec = addRange $ + do + h <- do { lexHIDING; return True } + is <- parens (commas import_) + return $ \r -> ImportSpecification_Import r h is + +import_ :: HParser Import +import_ = addRange $ + do + n <- var + return $ \r -> Import_Variable r n + +{- +decls -> "{" decl1 ";" ... ";" decln "}" (n>=0) +-} + +decls :: HParser Declarations +decls = + do + ds <- withLayout decl + return (CollectFunctionBindings.decls ds) + +{- +decl -> vars "::" type (type signature) + | ( funlhs | pat10 ) rhs +vars -> var1 "," ..."," varn (n>=1) +funlhs -> var apat* + | pat10 varop pat10 + | "(" funlhs ")" apat * + +Rewrite to reduce backtracking: + +decl -> [[ var ]] decl1 + | [[ pat10 ]] decl2 + | funlhs rhs +decl1 -> "," vars "::" type + | "::" type + | varop pat10 rhs + | "@" apat decl2 + | apat* rhs +decl2 -> varop pat10 rhs + | rhs +funlhs -> [[ var ]] funlhs1 + | [[ pat10 ]] varop pat10 + | "(" funlhs ")" apat* +funlhs1 -> varop pat10 + | apat* +-} + +decl :: HParser Declaration +decl = addRange ( + do fb <- lexCaseFeedback + return $ \r -> Declaration_FunctionBindings r + [FunctionBinding_Feedback r fb $ FunctionBinding_Hole r 0] + <|> + do + lexHOLE + jb <- optionMaybe normalRhs + case jb of + Just b -> return $ \r -> Declaration_PatternBinding r (Pattern_Hole r (-1)) b + Nothing -> return $ \r -> Declaration_Hole r (-1) + <|> + do + nr <- try (withRange var) + decl1 nr + <|> + do + pr <- try (withRange pat10) + decl2 pr + <|> + -- do + -- lexHOLE + -- return $ \r -> Declaration_Hole r (-1) + do + l <- funlhs + b <- normalRhs + return $ \r -> Declaration_FunctionBindings r + [FunctionBinding_FunctionBinding r l b] + ) Texts.parserDeclaration + +decl1 :: (Name, Range) -> HParser (Range -> Declaration) +decl1 (n, nr) = + do + lexCOMMA + ns <- vars + lexCOLCOL + t <- contextAndType + return $ \r -> Declaration_TypeSignature r (n:ns) t + <|> + do + lexCOLCOL + t <- contextAndType + return $ \r -> Declaration_TypeSignature r [n] t + <|> + do + o <- varop + (p, pr) <- withRange pat10 + b <- normalRhs + let lr = mergeRanges nr pr + return $ \r -> Declaration_FunctionBindings r + [FunctionBinding_FunctionBinding r + (LeftHandSide_Infix lr (Pattern_Variable nr n) o p) b] + <|> + do + lexAT + (p, pr) <- withRange apat + let completeRange = mergeRanges nr pr + asPat = Pattern_As completeRange n p + decl2 (asPat, completeRange) + <|> + do + (ps, rs) <- fmap unzip (many (withRange apat)) + let lr = if null rs then nr else mergeRanges nr (last rs) + b <- normalRhs + return $ \r -> + if null rs then + Declaration_PatternBinding r (Pattern_Variable nr n) b + else + Declaration_FunctionBindings r + [FunctionBinding_FunctionBinding r + (LeftHandSide_Function lr n ps) b] + +decl2 :: (Pattern, Range) -> HParser (Range -> Declaration) +decl2 (p1, p1r) = + do + o <- varop + (p2, p2r) <- withRange pat10 + b <- normalRhs + let lr = mergeRanges p1r p2r + return $ \r -> Declaration_FunctionBindings r + [FunctionBinding_FunctionBinding r + (LeftHandSide_Infix lr p1 o p2) b] + <|> + do + b <- normalRhs + return $ \r -> Declaration_PatternBinding r p1 b + +funlhs :: HParser LeftHandSide +funlhs = addRange $ + do + nr <- try (withRange var) + funlhs1 nr + <|> + do + p1 <- try pat10 + o <- varop + p2 <- pat10 + return $ \r -> LeftHandSide_Infix r p1 o p2 + <|> + do + l <- parens funlhs + ps <- many apat + return $ \r -> LeftHandSide_Parenthesized r l ps + +funlhs1 :: (Name, Range) -> HParser (Range -> LeftHandSide) +funlhs1 (n, nr) = + do + o <- varop + p <- pat10 + return $ \r -> LeftHandSide_Infix r + (Pattern_Variable nr n) o p + <|> + do + ps <- many apat + return $ \r -> LeftHandSide_Function r n ps + +vars :: HParser [Name] +vars = commas1 var + +{- +rhs -> "=" exp rhs1 + | gdexp+ rhs1 +rhs1 -> ( "where" decls )? +gdexp -> "|" exp0 "=" exp +-} + +normalRhs, caseRhs :: HParser RightHandSide +normalRhs = rhs lexASG +caseRhs = rhs lexRARROW + +-- The string is "->" for a case rhs and "=" for a normal rhs +rhs :: HParser () -> HParser RightHandSide +rhs equals = addRange $ + do + equals + e <- exp_ + mds <- option MaybeDeclarations_Nothing rhs1 + return $ \r -> RightHandSide_Expression r e mds + <|> + do + gs <- many1 (gdexp equals) + mds <- option MaybeDeclarations_Nothing rhs1 + return $ \r -> RightHandSide_Guarded r gs mds + +rhs1 :: HParser MaybeDeclarations +rhs1 = + do + lexWHERE + ds <- decls + return (MaybeDeclarations_Just ds) + +gdexp :: HParser () -> HParser GuardedExpression +gdexp equals = addRange $ + do + lexBAR + g <- exp0 + equals + e <- exp_ + return $ \r -> GuardedExpression_GuardedExpression r g e + + +-- exp_ = addRange ( +-- do +-- feedback <- option Nothing (try $ lexFeedback >>= return . Just) +-- e <- expOrg_ +-- return (maybe (const e) (\s -> \r -> Expression_Feedback r s e) feedback) +-- ) Texts.parserExpression + +{- +exp -> exp0 "::" type (expression type signature) + | exp0 +-} + +exp_ :: ParsecT [Token] SourcePos Identity Expression +exp_ = addRange ( + do + e <- exp0 + option (\_ -> e) $ + do + lexCOLCOL + t <- contextAndType + return $ \r -> Expression_Typed r e t + ) + Texts.parserExpression + +contextAndType :: HParser Type +contextAndType = addRange $ do + mc <- option Nothing (try $ do { c <- scontext; lexDARROW; return (Just c) }) + t <- type_ + case mc of + Nothing -> return $ \_ -> t + Just c -> return $ \r -> Type_Qualified r c t + +{- +expi -> expi+1 [op(n,i) expi+1] + | lexpi + | rexpi +lexpi -> (lexpi | expi+1) op(l,i) expi+1 +lexp6 -> - exp7 +rexpi -> expi+1 op(r,i) (rexpi | expi+1) + +Simplified, post-processing + +exp0 -> ( "-" )? exp10 ( op ( "-" )? exp10 )* + +See noRange in ParseCommon for an explanation of the parsing of infix expressions. +-} + +exp0 :: HParser Expression +exp0 = addRange ( + do + u <- maybeUnaryMinus + es <- exprChain + return $ \_ -> Expression_List noRange (u ++ es) + ) + Texts.parserExpression + +exprChain :: HParser [Expression] +exprChain = + do + e <- exp10 + es <- fmap concat $ many $ + do + o <- operatorAsExpression False + u <- maybeUnaryMinus + e' <- exp10 + return ([o] ++ u ++ [e']) + return (e:es) + +maybeUnaryMinus :: ParsecT [Token] SourcePos Identity [Expression] +maybeUnaryMinus = + option [] (fmap (:[]) unaryMinus) + Texts.parserExpression + +unaryMinus :: HParser Expression +unaryMinus = + do + (_, r) <- withRange lexMINDOT + return (Expression_Variable noRange (setNameRange floatUnaryMinusName r)) + <|> + do + (_, r) <- withRange lexMIN + return (Expression_Variable noRange (setNameRange intUnaryMinusName r)) + +{- +exp10 -> "\" apat1 ... apatn "->" exp (lambda abstraction, n>=1) + | "let" decls "in" exp (let expression) + | "if" exp "then" exp "else" exp (conditional) + | "case" exp "of" alts (case expression) + | "do" stmts (do expression) + | fexp +-} + +exp10 :: HParser Expression +exp10 = addRange ( + do + lexBSLASH + ps <- many1 apat + lexRARROW + e <- exp_ + return $ \r -> Expression_Lambda r ps e + <|> + (do + lexLET + ds <- decls + lexIN + e <- exp_ + return $ \r -> Expression_Let r ds e) + <|> + do + lexIF + e1 <- exp_ + lexTHEN + e2 <- exp_ + lexELSE + e3 <- exp_ + return $ \r -> Expression_If r e1 e2 e3 + <|> + do + lexCASE + e <- exp_ + lexOF + as <- alts + return $ \r -> Expression_Case r e as + <|> + do + lexDO + ss <- stmts + return $ \r -> Expression_Do r ss + ) + <|> + fexp + Texts.parserExpression + +{- +fexp -> aexp+ +-} + +fexp :: HParser Expression +fexp = addRange $ + do + (e:es) <- many1 aexp + if null es then + return $ \_ -> e + else + return $ \r -> Expression_NormalApplication r e es + + +{- +aexp -> var (variable) + | con + | literal + + | "[" "]" + | "[" exp1 "," ... "," expk "]" + | "[" exp1 ( "," exp2 )? ".." exp3? "]" + | "[" exp "|" qual1 "," ... "," qualn "]" + + | () + | (op fexp) (left section) + | (fexp op) (right section) + | ( exp ) (parenthesized expression) + | ( exp1 , ... , expk ) (tuple, k>=2) + +Last cases parsed as: + + "(" "-" exprChain ( "," exp_ )* ")" + | "(" op fexp ")" + | "(" fexp op ")" + | "(" ( exp_ ) ")" +-} + +operatorAsExpression :: Bool -> HParser Expression +operatorAsExpression storeRange = (do + (o, r) <- withRange ( fmap Left varsym <|> fmap Right consym + <|> lexBACKQUOTEs (fmap Left varid <|> fmap Right conid)) + let range = if storeRange then r else noRange + return (case o of + Left v -> Expression_Variable range v + Right c -> Expression_Constructor range c + )) Texts.parserOperator + +aexp :: HParser Expression +aexp = addRange ( + do + lexLPAREN + ( -- dit haakje is nodig (snap niet waarom). Arjan + try (do -- de try vanwege (-) DEZE PARSER MOET OPNIEUW GESCHREVEN WORDEN !!! + ue <- do + u <- unaryMinus + es <- exprChain + return (Expression_List noRange (u:es)) + es <- many (do { lexCOMMA; exp_ }) + lexRPAREN + return $ + if null es then + \r -> Expression_Parenthesized r ue + else + \r -> Expression_Tuple r (ue:es)) + <|> + do -- operator followed by optional expression + -- either full section (if there is no expression) or + -- a left section (if there is) + opExpr <- operatorAsExpression True + me <- option Nothing (fmap Just fexp) + lexRPAREN + return $ \r -> + Expression_InfixApplication r + MaybeExpression_Nothing + opExpr + (case me of + Nothing -> MaybeExpression_Nothing + Just e -> MaybeExpression_Just e) + <|> + try (do -- right section, expression followed by operator + -- or a parenthesized expression (if no operator is found) + e <- fexp + mo <- option Nothing (fmap Just (operatorAsExpression True)) + lexRPAREN + return $ \r -> + case mo of + Nothing -> Expression_Parenthesized r e + Just opExpr -> + Expression_InfixApplication r + (MaybeExpression_Just e) + opExpr + MaybeExpression_Nothing + ) + <|> + do -- unit "()", expression between parenthesis or a tuple + es <- commas exp_ + lexRPAREN + return $ \r -> case es of + [] -> Expression_Constructor r (Name_Special r [] "()") -- !!!Name + [e] -> Expression_Parenthesized r e + _ -> Expression_Tuple r es + ) + <|> + do + n <- varid + return $ \r -> Expression_Variable r n + <|> + do + n <- conid + return $ \r -> Expression_Constructor r n + <|> + do + lexHOLE + return $ \r -> Expression_Hole r (-1) + <|> + do + feedback <- lexFeedback + e <- aexp + return $ \r -> Expression_Feedback r feedback e + <|> + do + lexeme LexMustUse + e <- aexp + return $ \r -> Expression_MustUse r e + <|> + do + l <- literal + return $ \r -> Expression_Literal r l + <|> + do + lexLBRACKET + aexp1 + ) Texts.parserExpression + +{- +Last four cases, rewritten to eliminate backtracking + +aexp -> ... + | "[" aexp1 +aexp1 -> "]" + | exp aexp2 "]" +aexp2 -> "|" qual1 "," ... "," qualn + | ".." exp? + | "," exp aexp3 + | (empty) +aexp3 -> ".." exp? + | ( "," exp )* +-} + +aexp1 :: HParser (Range -> Expression) +aexp1 = + do + lexRBRACKET + return $ \r -> Expression_Constructor r + (Name_Special r [] "[]") -- !!!Name + <|> + do + e1 <- exp_ + e2 <- aexp2 e1 + lexRBRACKET + return e2 + +aexp2 :: Expression -> HParser (Range -> Expression) +aexp2 e1 = + do + lexBAR + qs <- commas1 qual + return $ \r -> Expression_Comprehension r e1 qs + <|> + do + lexDOTDOT + option (\r -> Expression_Enum r e1 + MaybeExpression_Nothing + MaybeExpression_Nothing) $ + do + e2 <- exp_ + return $ \r -> Expression_Enum r e1 + MaybeExpression_Nothing + (MaybeExpression_Just e2) + <|> + do + lexCOMMA + e2 <- exp_ + aexp3 e1 e2 + <|> + return (\r -> Expression_List r [e1]) + +aexp3 :: Expression -> Expression -> HParser (Range -> Expression) +aexp3 e1 e2 = + do + lexDOTDOT + option (\r -> Expression_Enum r e1 + (MaybeExpression_Just e2) + MaybeExpression_Nothing) $ + do + e3 <- exp_ + return $ \r -> Expression_Enum r e1 + (MaybeExpression_Just e2) + (MaybeExpression_Just e3) + <|> + do + es <- many (do { lexCOMMA; exp_ }) + return $ \r -> Expression_List r (e1:e2:es) + +{- +stmts -> "{" stmt1 ";" ... ";" stmtn "}" (n>=0) +-} + +stmts :: HParser Statements +stmts = + withLayout stmt + +{- +stmt -> "let" decls + | pat "<-" exp + | exp +-} + +stmt :: HParser Statement +stmt = addRange $ + do + lexLET + ds <- decls + option (\r -> Statement_Let r ds) $ do + lexIN + e <- exp_ + return (\r -> Statement_Expression r (Expression_Let r ds e)) + <|> + do + p <- try $ + do + p <- pat + lexLARROW + return p + e <- exp_ + return $ \r -> Statement_Generator r p e + <|> + do + e <- exp_ + return $ \r -> Statement_Expression r e + +{- +alts -> "{" alt1 ";" ... ";" altn "}" (n>=0) +-} + +alts :: HParser Alternatives +alts = + do as <- withLayout alt + return $ CollectFunctionBindings.mergeCaseFeedback as + +{- +alt -> pat rhs +-} + +alt :: HParser Alternative +alt = addRange $ + do fb <- lexCaseFeedback + return $ \r -> Alternative_Feedback r fb $ Alternative_Hole r (-1) + <|> + do + lexHOLE + return $ \r -> Alternative_Hole r (-1) + <|> + do + p <- pat + b <- caseRhs + return $ \r -> Alternative_Alternative r p b + +{- +qual -> "let" decls (local declaration) + | pat "<-" exp (generator) + | exp (guard) +-} + +qual :: HParser Qualifier +qual = addRange $ + do + lexLET + ds <- decls + option (\r -> Qualifier_Let r ds) $ do + lexIN + e <- exp_ + return (\r -> Qualifier_Guard r (Expression_Let r ds e)) + <|> + do + p <- try $ + do + p <- pat + lexLARROW + return p + e <- exp_ + return $ \r -> Qualifier_Generator r p e + <|> + do + e <- exp_ + return $ \r -> Qualifier_Guard r e + +{- +pat -> pat0 +pati -> pati+1 [conop(n,i) pati+1] + | lpati + | rpati +lpati -> (lpati | pati+1) conop(l,i) pati+1 +lpat6 -> - (integer | float) (negative literal) +rpati -> pati+1 conop(r,i) (rpati | pati+1) + +See noRange in ParseCommon for an explanation of the parsing of infix expressions. + +-} + +pat :: HParser Pattern +pat = addRange $ + do + u <- unaryMinusPat + ps <- fmap concat $ many $ + do + o <- do { n <- conop; return (Pattern_Variable noRange n) } + u' <- unaryMinusPat + return (o : u') + return $ \_ -> Pattern_List noRange (u ++ ps) + +unaryMinusPat :: HParser [Pattern] +unaryMinusPat = + do + (n, mr) <- withRange (do { lexMINDOT; return floatUnaryMinusName } <|> + do { lexMIN; return intUnaryMinusName } ) + (l, lr) <- withRange numericLiteral + return + [ Pattern_Variable noRange (setNameRange n mr) + , Pattern_Literal lr l + ] + <|> + do + p <- pat10 + return [p] + +{- +pat10 -> con apat* + | apat +-} + +pat10 :: HParser Pattern +pat10 = addRange ( + do + n <- try con + ps <- many apat + return $ \r -> Pattern_Constructor r n ps + ) + <|> + apat + Texts.parserPattern + +{- +apat -> var ( "@" apat )? + + | "(" ")" + | "(" pat ")" (parenthesized pattern) + | "(" pat1 "," ... "," patk ")" (tuple pattern, k>=2) + + | "[" "]" + | "[" pat1 "," ... "," patk "]" (list pattern, k>=1) + + | "_" (wildcard) + | con (arity con = 0) + | literal + | "~" apat (irrefutable pattern) +-} + +apat :: HParser Pattern +apat = addRange ( + do + v <- try var -- because of parentheses + option (\r -> Pattern_Variable r v) $ do + lexAT + p <- apat + return $ \r -> Pattern_As r v p + <|> + do + ps <- parens (commas pat) + return $ \r -> case ps of + [] -> Pattern_Constructor r (Name_Special r [] "()") [] -- !!!Name + [p] -> Pattern_Parenthesized r p + _ -> Pattern_Tuple r ps + <|> + do + ps <- brackets (commas pat) + return $ \r -> case ps of + [] -> Pattern_Constructor r (Name_Special r [] "[]") [] -- !!!Name + _ -> Pattern_List r ps + <|> + do + lexUNDERSCORE + return $ \r -> Pattern_Wildcard r + <|> + do + n <- con + return $ \r -> Pattern_Constructor r n [] + <|> + do + l <- literal + return $ \r -> Pattern_Literal r l + <|> + do + lexTILDE + p <- apat + return $ \r -> Pattern_Irrefutable r p + ) <|> phole Texts.parserPattern + +phole :: HParser Pattern +phole = addRange ( + do + lexHOLE + return $ \r -> Pattern_Hole r (-1) + ) + +{- +scontext -> class | "(" class1 "," ... "," classn ")" (n>=0) +simpleclass -> tycls tyvar + (other case in Haskell report at 'class' is not supported in Helium + because we do not have type variable application) +-} + +scontext :: HParser ContextItems +scontext = + do { c <- simpleclass; return [c] } + <|> + parens (commas simpleclass) + +simpleclass :: HParser ContextItem +simpleclass = addRange (do + c <- tycon + (v, vr) <- withRange tyvar + return $ \r -> ContextItem_ContextItem r c [Type_Variable vr v] + ) + +{- +type -> btype ( "->" type )? +-} + +type_ :: HParser Type +type_ = addRange ( + do + left <- btype + option (\_ -> left) $ + do + (_, rangeArrow) <- withRange lexRARROW + right <- type_ + return (\r -> Type_Application r False + (Type_Constructor rangeArrow (Name_Special rangeArrow [] "->")) [left, right]) -- !!!Name + ) Texts.parserType + +{- +btype -> atype+ +-} + +btype :: HParser Type +btype = addRange ( + do + ts <- many1 atype + return $ \r -> case ts of + [t] -> t + (t:ts') -> Type_Application r True t ts' + [] -> error "Pattern match failure in Parser.Parser.btype" + ) Texts.parserType + +{- +atype -> tycon + | tyvar + | "(" ")" (unit type) + | "(" type1 "," ... "," typek ")" (tuple type, k>=2) + | "(" type ")" (parenthesized constructor) + | "[" type "]" (list type) +-} + +atype :: HParser Type +atype = addRange ( + do + c <- tycon + return (\r -> Type_Constructor r c) + <|> + do + c <- tyvar + return (\r -> Type_Variable r c) + <|> + do + ts <- parens (commas type_) + return (\r -> case ts of + [] -> Type_Constructor r (Name_Special r [] "()") -- !!!Name + [t] -> Type_Parenthesized r t + _ -> let n = Name_Special r [] -- !!!Name + ( "(" ++ replicate (length ts - 1) ',' ++ ")" ) + in Type_Application r False (Type_Constructor r n) ts + ) + <|> + do + t <- brackets type_ + return $ \r -> + let n = Name_Special r [] "[]" -- !!!Name + in Type_Application r False (Type_Constructor r n) [t] + ) Texts.parserType + +annotatedType :: HParser Type -> HParser AnnotatedType +annotatedType p = addRange $ + do + t <- p + return (\r -> AnnotatedType_AnnotatedType r False t) + +literal :: ParsecT [Token] SourcePos Identity Literal +literal = addRange ( + do + i <- lexInt + return $ \r -> Literal_Int r i + <|> + do + d <- lexDouble + return $ \r -> Literal_Float r d + <|> + do + c <- lexChar + return $ \r -> Literal_Char r c + <|> + do + s <- lexString + return $ \r -> Literal_String r s + ) Texts.parserLiteral + +numericLiteral :: ParsecT [Token] SourcePos Identity Literal +numericLiteral = addRange ( + do + i <- lexInt + return $ \r -> Literal_Int r i + <|> + do + d <- lexDouble + return $ \r -> Literal_Float r d + ) Texts.parserNumericLiteral diff --git a/src/Helium/Parser/ResolveOperators.ag b/src/Helium/Parser/ResolveOperators.ag new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/ResolveOperators.ag @@ -0,0 +1,232 @@ +imports{ + +import Helium.Syntax.UHA_Utils +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Range +import Helium.Parser.OperatorTable +import Helium.Utils.Utils +import Helium.StaticAnalysis.Messages.Messages + +import qualified Data.Map as M +} + +INCLUDE "UHA_Syntax.ag" + +{ + +data ResolveError = + Ambiguous Assoc Name Assoc Name + +instance HasMessage ResolveError where + getRanges (Ambiguous _ n1 _ n2) = + [ getNameRange n1, getNameRange n2 ] + + getMessage (Ambiguous assoc1 op1 assoc2 op2) = + let + assocString AssocRight = "right-associative" + assocString AssocLeft = "left-associative" + assocString AssocNone = "non-associative" + + firstLine = + "Ambiguous use of " + ++ assocString (assoc1) + ++ " operator " + ++ show op1 + secondLine = + " with " + ++ assocString (assoc2) + ++ " operator " + ++ show op2 + in [ MessageOneLiner ( MessageString $ firstLine ++ secondLine ) ] + +resolveOperators :: OperatorTable -> Module -> (Module, [ResolveError]) +resolveOperators opTable m = + let res = wrap_Module (sem_Module m) (Inh_Module { opTable_Inh_Module = opTable, resolveErrors_Inh_Module = [] }) + in (self_Syn_Module res, resolveErrors_Syn_Module res) + +expression :: OperatorTable -> Expression -> Expression +expression opTable e = -- !!! errors ignored + let res = wrap_Expression (sem_Expression e) (Inh_Expression { opTable_Inh_Expression = opTable, resolveErrors_Inh_Expression = [] }) + in self_Syn_Expression res + +operatorsFromModule :: Module -> OperatorTable +operatorsFromModule m = + M.fromList (concatMap declToOps (collectInfixdecls m)) + where + declToOps (Declaration_Fixity _ f (MaybeInt_Just p) os) = + [ (o, (p, fixityToAssoc f)) | o <- os ] + declToOps _ = error "not supported" + fixityToAssoc f = case f of + Fixity_Infixl _ -> AssocLeft + Fixity_Infixr _ -> AssocRight + Fixity_Infix _ -> AssocNone + +collectInfixdecls :: Module -> [Declaration] +collectInfixdecls + (Module_Module _ _ _ (Body_Body _ _ ds)) = filter isInfixdecl ds + where + isInfixdecl (Declaration_Fixity _ _ _ _) = True + isInfixdecl _ = False +collectInfixdecls (Module_Module _ _ _ (Body_Hole _ _)) = error "not supported" +} + +ATTR Module Body Declarations Declaration FunctionBindings RightHandSide + FunctionBinding LeftHandSide MaybeDeclarations GuardedExpressions + GuardedExpression Expression Patterns Pattern Alternatives Alternative + Qualifiers Qualifier Statements Statement MaybeExpression Expressions + RecordExpressionBinding RecordPatternBinding RecordPatternBindings + RecordExpressionBindings + [ opTable : OperatorTable + | resolveErrors : { [ResolveError] } + | + ] + +SEM Pattern + | List lhs.resolveErrors = @errs ++ @patterns.resolveErrors + loc . (self, errs) = + case @range.self of + Range_Range Position_Unknown Position_Unknown -> + resolvePattern @lhs.opTable @patterns.self + _ -> + (Pattern_List @range.self @patterns.self, []) + +SEM Expression + | List lhs . resolveErrors = @errs ++ @expressions.resolveErrors + loc . (self, errs) = + case @range.self of + Range_Range Position_Unknown Position_Unknown -> + resolveExpression @lhs.opTable @expressions.self + _ -> (Expression_List @range.self @expressions.self, []) + +{ +type State expr = + ( [Name] -- operator stack + , [expr] -- expression/pattern stack + , [ResolveError] + ) + +resolveExpression :: OperatorTable -> [Expression] -> (Expression, [ResolveError]) +resolveExpression opTable es = resolve opTable es (getOp, applyMinus, applyBinary) ([], [], []) + where + getOp (Expression_Variable (Range_Range Position_Unknown Position_Unknown) n) = Just n + getOp (Expression_Constructor (Range_Range Position_Unknown Position_Unknown) n) = Just n + getOp _ = Nothing + + applyMinus :: Name -> Expression -> Expression + applyMinus n e + | n == intUnaryMinusName = + Expression_Negate (mergeRanges (getNameRange n) (getExprRange e)) e + | n == floatUnaryMinusName = + Expression_NegateFloat (mergeRanges (getNameRange n) (getExprRange e)) e + | otherwise = internalError + "ResolveOperators.hs" "resolveExpression.applyMinus" "unknown unary operator" + + applyBinary :: Name -> Expression -> Expression -> Expression + applyBinary n e1 e2 = + Expression_InfixApplication + (mergeRanges (getExprRange e1) (getExprRange e2)) + (MaybeExpression_Just e1) + ((if isConstructor n then Expression_Constructor else Expression_Variable) (getNameRange n) n) + (MaybeExpression_Just e2) + +resolvePattern :: OperatorTable -> [Pattern] -> (Pattern, [ResolveError]) +resolvePattern opTable ps = resolve opTable ps (getOp, applyMinus, applyBinary) ([], [], []) + where + getOp (Pattern_Variable (Range_Range Position_Unknown Position_Unknown) n) = Just n + getOp _ = Nothing + + applyMinus :: Name -> Pattern -> Pattern + applyMinus n (Pattern_Literal r l) + | n == intUnaryMinusName = + Pattern_Negate (mergeRanges (getNameRange n) r) l + | n == floatUnaryMinusName = + Pattern_NegateFloat (mergeRanges (getNameRange n) r) l + | otherwise = internalError + "ResolveOperators.hs" "resolvePattern.applyMinus" "unknown unary operator" + applyMinus _ _ = + internalError "ResolveOperators" "resolvePattern" "in patterns unary minus is only allowed in front of literals" + + applyBinary :: Name -> Pattern -> Pattern -> Pattern + applyBinary n p1 p2 = + Pattern_InfixConstructor + (mergeRanges (getPatRange p1) (getPatRange p2)) + p1 n p2 + +resolve :: + OperatorTable -> + [expr] -> + ( expr -> Maybe Name -- get operator name (if it is one) + , Name -> expr -> expr -- apply minus + , Name -> expr -> expr -> expr -- apply binary + ) + -> State expr -> (expr, [ResolveError]) +resolve opTable exprs fs@(getOp, applyMinus, applyBinary) state = + case exprs of + [] -> cleanup state + (expr:restExprs) -> + let newState = + case getOp expr of + Nothing -> pushExpr expr state + Just name -> pushOp opTable name state + in + resolve opTable restExprs fs newState + where +-- popOp :: State expr -> State expr + popOp (op:ops, restExprs, errs) + | isUnary op = + case restExprs of + (expr:rest) -> (ops, applyMinus op expr : rest, errs) + _ -> internalError "ResolveOperators" "popOp" "1" + | otherwise = + case restExprs of + (expr2:expr1:rest) -> (ops, applyBinary op expr1 expr2 : rest, errs) + _ -> internalError "ResolveOperators" "popOp" "2" + popOp _ = error "pattern match failure in Parser.ResolveOperators.popOp" +-- pushOp :: Name -> State expr -> State expr + pushOp operTable op theState@(top:ops, restExprs, errs) = + case strongerOp operTable top op of + Left True -> pushOp operTable op (popOp theState) + Left False -> (op:top:ops, restExprs, errs) + Right err -> (op:top:ops, restExprs, err : errs) -- arbitrary choice + pushOp _ op ([], restExprs, errs) = + ([op], restExprs, errs) +-- cleanup :: State expr -> expr + cleanup theState@(_:_, _, _) = cleanup (popOp theState) + cleanup (_, [expr], errs) = (expr, errs) + cleanup _ = internalError "ResolveOperators" "cleanup" "invalid state" + + +pushExpr :: expr -> State expr -> State expr +pushExpr expr (ops, exprs, errs) = + (ops, expr:exprs, errs) + +strongerOp :: OperatorTable -> Name -> Name -> Either Bool ResolveError +strongerOp opTable op1 op2 + | isBinary op1 && isBinary op2 = + if prio1 == prio2 then + if assoc1 == AssocLeft && assoc2 == AssocLeft then + Left True + else if assoc1 == AssocRight && assoc2 == AssocRight then + Left False + else + Right (Ambiguous assoc1 op1 assoc2 op2) + else + Left (prio1 > prio2) + | isUnary op1 && isBinary op2 = + Left (prio1 >= prio2) + | isUnary op2 = + Left False + | otherwise = internalError "ResolveOperators" "strongerOp" "unable to determine which operator binds stronger" + where + assoc1 = assoc opTable op1 + assoc2 = assoc opTable op2 + prio1 = prio opTable op1 + prio2 = prio opTable op2 + +isUnary :: Name -> Bool +isUnary name = name `elem` [ intUnaryMinusName, floatUnaryMinusName ] + +isBinary :: Name -> Bool +isBinary = not . isUnary + +} diff --git a/src/Helium/Parser/ResolveOperators.hs b/src/Helium/Parser/ResolveOperators.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Parser/ResolveOperators.hs @@ -0,0 +1,7108 @@ +{-# LANGUAGE Rank2Types, GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Helium.Parser.ResolveOperators where + + +import Helium.Syntax.UHA_Utils +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Range +import Helium.Parser.OperatorTable +import Helium.Utils.Utils +import Helium.StaticAnalysis.Messages.Messages + +import qualified Data.Map as M +import Control.Monad.Identity (Identity) +import qualified Control.Monad.Identity + + +data ResolveError = + Ambiguous Assoc Name Assoc Name + +instance HasMessage ResolveError where + getRanges (Ambiguous _ n1 _ n2) = + [ getNameRange n1, getNameRange n2 ] + + getMessage (Ambiguous assoc1 op1 assoc2 op2) = + let + assocString AssocRight = "right-associative" + assocString AssocLeft = "left-associative" + assocString AssocNone = "non-associative" + + firstLine = + "Ambiguous use of " + ++ assocString (assoc1) + ++ " operator " + ++ show op1 + secondLine = + " with " + ++ assocString (assoc2) + ++ " operator " + ++ show op2 + in [ MessageOneLiner ( MessageString $ firstLine ++ secondLine ) ] + +resolveOperators :: OperatorTable -> Module -> (Module, [ResolveError]) +resolveOperators opTable m = + let res = wrap_Module (sem_Module m) (Inh_Module { opTable_Inh_Module = opTable, resolveErrors_Inh_Module = [] }) + in (self_Syn_Module res, resolveErrors_Syn_Module res) + +expression :: OperatorTable -> Expression -> Expression +expression opTable e = -- !!! errors ignored + let res = wrap_Expression (sem_Expression e) (Inh_Expression { opTable_Inh_Expression = opTable, resolveErrors_Inh_Expression = [] }) + in self_Syn_Expression res + +operatorsFromModule :: Module -> OperatorTable +operatorsFromModule m = + M.fromList (concatMap declToOps (collectInfixdecls m)) + where + declToOps (Declaration_Fixity _ f (MaybeInt_Just p) os) = + [ (o, (p, fixityToAssoc f)) | o <- os ] + declToOps _ = error "not supported" + fixityToAssoc f = case f of + Fixity_Infixl _ -> AssocLeft + Fixity_Infixr _ -> AssocRight + Fixity_Infix _ -> AssocNone + +collectInfixdecls :: Module -> [Declaration] +collectInfixdecls + (Module_Module _ _ _ (Body_Body _ _ ds)) = filter isInfixdecl ds + where + isInfixdecl (Declaration_Fixity _ _ _ _) = True + isInfixdecl _ = False +collectInfixdecls (Module_Module _ _ _ (Body_Hole _ _)) = error "not supported" + + +type State expr = + ( [Name] -- operator stack + , [expr] -- expression/pattern stack + , [ResolveError] + ) + +resolveExpression :: OperatorTable -> [Expression] -> (Expression, [ResolveError]) +resolveExpression opTable es = resolve opTable es (getOp, applyMinus, applyBinary) ([], [], []) + where + getOp (Expression_Variable (Range_Range Position_Unknown Position_Unknown) n) = Just n + getOp (Expression_Constructor (Range_Range Position_Unknown Position_Unknown) n) = Just n + getOp _ = Nothing + + applyMinus :: Name -> Expression -> Expression + applyMinus n e + | n == intUnaryMinusName = + Expression_Negate (mergeRanges (getNameRange n) (getExprRange e)) e + | n == floatUnaryMinusName = + Expression_NegateFloat (mergeRanges (getNameRange n) (getExprRange e)) e + | otherwise = internalError + "ResolveOperators.hs" "resolveExpression.applyMinus" "unknown unary operator" + + applyBinary :: Name -> Expression -> Expression -> Expression + applyBinary n e1 e2 = + Expression_InfixApplication + (mergeRanges (getExprRange e1) (getExprRange e2)) + (MaybeExpression_Just e1) + ((if isConstructor n then Expression_Constructor else Expression_Variable) (getNameRange n) n) + (MaybeExpression_Just e2) + +resolvePattern :: OperatorTable -> [Pattern] -> (Pattern, [ResolveError]) +resolvePattern opTable ps = resolve opTable ps (getOp, applyMinus, applyBinary) ([], [], []) + where + getOp (Pattern_Variable (Range_Range Position_Unknown Position_Unknown) n) = Just n + getOp _ = Nothing + + applyMinus :: Name -> Pattern -> Pattern + applyMinus n (Pattern_Literal r l) + | n == intUnaryMinusName = + Pattern_Negate (mergeRanges (getNameRange n) r) l + | n == floatUnaryMinusName = + Pattern_NegateFloat (mergeRanges (getNameRange n) r) l + | otherwise = internalError + "ResolveOperators.hs" "resolvePattern.applyMinus" "unknown unary operator" + applyMinus _ _ = + internalError "ResolveOperators" "resolvePattern" "in patterns unary minus is only allowed in front of literals" + + applyBinary :: Name -> Pattern -> Pattern -> Pattern + applyBinary n p1 p2 = + Pattern_InfixConstructor + (mergeRanges (getPatRange p1) (getPatRange p2)) + p1 n p2 + +resolve :: + OperatorTable -> + [expr] -> + ( expr -> Maybe Name -- get operator name (if it is one) + , Name -> expr -> expr -- apply minus + , Name -> expr -> expr -> expr -- apply binary + ) + -> State expr -> (expr, [ResolveError]) +resolve opTable exprs fs@(getOp, applyMinus, applyBinary) state = + case exprs of + [] -> cleanup state + (expr:restExprs) -> + let newState = + case getOp expr of + Nothing -> pushExpr expr state + Just name -> pushOp opTable name state + in + resolve opTable restExprs fs newState + where +-- popOp :: State expr -> State expr + popOp (op:ops, restExprs, errs) + | isUnary op = + case restExprs of + (expr:rest) -> (ops, applyMinus op expr : rest, errs) + _ -> internalError "ResolveOperators" "popOp" "1" + | otherwise = + case restExprs of + (expr2:expr1:rest) -> (ops, applyBinary op expr1 expr2 : rest, errs) + _ -> internalError "ResolveOperators" "popOp" "2" + popOp _ = error "pattern match failure in Parser.ResolveOperators.popOp" +-- pushOp :: Name -> State expr -> State expr + pushOp operTable op theState@(top:ops, restExprs, errs) = + case strongerOp operTable top op of + Left True -> pushOp operTable op (popOp theState) + Left False -> (op:top:ops, restExprs, errs) + Right err -> (op:top:ops, restExprs, err : errs) -- arbitrary choice + pushOp _ op ([], restExprs, errs) = + ([op], restExprs, errs) +-- cleanup :: State expr -> expr + cleanup theState@(_:_, _, _) = cleanup (popOp theState) + cleanup (_, [expr], errs) = (expr, errs) + cleanup _ = internalError "ResolveOperators" "cleanup" "invalid state" + + +pushExpr :: expr -> State expr -> State expr +pushExpr expr (ops, exprs, errs) = + (ops, expr:exprs, errs) + +strongerOp :: OperatorTable -> Name -> Name -> Either Bool ResolveError +strongerOp opTable op1 op2 + | isBinary op1 && isBinary op2 = + if prio1 == prio2 then + if assoc1 == AssocLeft && assoc2 == AssocLeft then + Left True + else if assoc1 == AssocRight && assoc2 == AssocRight then + Left False + else + Right (Ambiguous assoc1 op1 assoc2 op2) + else + Left (prio1 > prio2) + | isUnary op1 && isBinary op2 = + Left (prio1 >= prio2) + | isUnary op2 = + Left False + | otherwise = internalError "ResolveOperators" "strongerOp" "unable to determine which operator binds stronger" + where + assoc1 = assoc opTable op1 + assoc2 = assoc opTable op2 + prio1 = prio opTable op1 + prio2 = prio opTable op2 + +isUnary :: Name -> Bool +isUnary name = name `elem` [ intUnaryMinusName, floatUnaryMinusName ] + +isBinary :: Name -> Bool +isBinary = not . isUnary + +-- Alternative ------------------------------------------------- +-- wrapper +data Inh_Alternative = Inh_Alternative { opTable_Inh_Alternative :: (OperatorTable), resolveErrors_Inh_Alternative :: ( [ResolveError] ) } +data Syn_Alternative = Syn_Alternative { resolveErrors_Syn_Alternative :: ( [ResolveError] ), self_Syn_Alternative :: (Alternative) } +{-# INLINABLE wrap_Alternative #-} +wrap_Alternative :: T_Alternative -> Inh_Alternative -> (Syn_Alternative ) +wrap_Alternative (T_Alternative act) (Inh_Alternative _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternative_vIn1 _lhsIopTable _lhsIresolveErrors + (T_Alternative_vOut1 _lhsOresolveErrors _lhsOself) <- return (inv_Alternative_s2 sem arg) + return (Syn_Alternative _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternative #-} +sem_Alternative :: Alternative -> T_Alternative +sem_Alternative ( Alternative_Hole range_ id_ ) = sem_Alternative_Hole ( sem_Range range_ ) id_ +sem_Alternative ( Alternative_Feedback range_ feedback_ alternative_ ) = sem_Alternative_Feedback ( sem_Range range_ ) feedback_ ( sem_Alternative alternative_ ) +sem_Alternative ( Alternative_Alternative range_ pattern_ righthandside_ ) = sem_Alternative_Alternative ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Alternative ( Alternative_Empty range_ ) = sem_Alternative_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Alternative = T_Alternative { + attach_T_Alternative :: Identity (T_Alternative_s2 ) + } +newtype T_Alternative_s2 = C_Alternative_s2 { + inv_Alternative_s2 :: (T_Alternative_v1 ) + } +data T_Alternative_s3 = C_Alternative_s3 +type T_Alternative_v1 = (T_Alternative_vIn1 ) -> (T_Alternative_vOut1 ) +data T_Alternative_vIn1 = T_Alternative_vIn1 (OperatorTable) ( [ResolveError] ) +data T_Alternative_vOut1 = T_Alternative_vOut1 ( [ResolveError] ) (Alternative) +{-# NOINLINE sem_Alternative_Hole #-} +sem_Alternative_Hole :: T_Range -> (Integer) -> T_Alternative +sem_Alternative_Hole arg_range_ arg_id_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule0 _rangeIself arg_id_ + _lhsOself :: Alternative + _lhsOself = rule1 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule2 _lhsIresolveErrors + __result_ = T_Alternative_vOut1 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule0 #-} + rule0 = \ ((_rangeIself) :: Range) id_ -> + Alternative_Hole _rangeIself id_ + {-# INLINE rule1 #-} + rule1 = \ _self -> + _self + {-# INLINE rule2 #-} + rule2 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Alternative_Feedback #-} +sem_Alternative_Feedback :: T_Range -> (String) -> T_Alternative -> T_Alternative +sem_Alternative_Feedback arg_range_ arg_feedback_ arg_alternative_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _alternativeX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_alternative_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Alternative_vOut1 _alternativeIresolveErrors _alternativeIself) = inv_Alternative_s2 _alternativeX2 (T_Alternative_vIn1 _alternativeOopTable _alternativeOresolveErrors) + _self = rule3 _alternativeIself _rangeIself arg_feedback_ + _lhsOself :: Alternative + _lhsOself = rule4 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule5 _alternativeIresolveErrors + _alternativeOopTable = rule6 _lhsIopTable + _alternativeOresolveErrors = rule7 _lhsIresolveErrors + __result_ = T_Alternative_vOut1 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule3 #-} + rule3 = \ ((_alternativeIself) :: Alternative) ((_rangeIself) :: Range) feedback_ -> + Alternative_Feedback _rangeIself feedback_ _alternativeIself + {-# INLINE rule4 #-} + rule4 = \ _self -> + _self + {-# INLINE rule5 #-} + rule5 = \ ((_alternativeIresolveErrors) :: [ResolveError] ) -> + _alternativeIresolveErrors + {-# INLINE rule6 #-} + rule6 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule7 #-} + rule7 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Alternative_Alternative #-} +sem_Alternative_Alternative :: T_Range -> T_Pattern -> T_RightHandSide -> T_Alternative +sem_Alternative_Alternative arg_range_ arg_pattern_ arg_righthandside_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIresolveErrors _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOopTable _patternOresolveErrors) + (T_RightHandSide_vOut148 _righthandsideIresolveErrors _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOopTable _righthandsideOresolveErrors) + _self = rule8 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Alternative + _lhsOself = rule9 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule10 _righthandsideIresolveErrors + _patternOopTable = rule11 _lhsIopTable + _patternOresolveErrors = rule12 _lhsIresolveErrors + _righthandsideOopTable = rule13 _lhsIopTable + _righthandsideOresolveErrors = rule14 _patternIresolveErrors + __result_ = T_Alternative_vOut1 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule8 #-} + rule8 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Alternative_Alternative _rangeIself _patternIself _righthandsideIself + {-# INLINE rule9 #-} + rule9 = \ _self -> + _self + {-# INLINE rule10 #-} + rule10 = \ ((_righthandsideIresolveErrors) :: [ResolveError] ) -> + _righthandsideIresolveErrors + {-# INLINE rule11 #-} + rule11 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule12 #-} + rule12 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule13 #-} + rule13 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule14 #-} + rule14 = \ ((_patternIresolveErrors) :: [ResolveError] ) -> + _patternIresolveErrors +{-# NOINLINE sem_Alternative_Empty #-} +sem_Alternative_Empty :: T_Range -> T_Alternative +sem_Alternative_Empty arg_range_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule15 _rangeIself + _lhsOself :: Alternative + _lhsOself = rule16 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule17 _lhsIresolveErrors + __result_ = T_Alternative_vOut1 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule15 #-} + rule15 = \ ((_rangeIself) :: Range) -> + Alternative_Empty _rangeIself + {-# INLINE rule16 #-} + rule16 = \ _self -> + _self + {-# INLINE rule17 #-} + rule17 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Alternatives ------------------------------------------------ +-- wrapper +data Inh_Alternatives = Inh_Alternatives { opTable_Inh_Alternatives :: (OperatorTable), resolveErrors_Inh_Alternatives :: ( [ResolveError] ) } +data Syn_Alternatives = Syn_Alternatives { resolveErrors_Syn_Alternatives :: ( [ResolveError] ), self_Syn_Alternatives :: (Alternatives) } +{-# INLINABLE wrap_Alternatives #-} +wrap_Alternatives :: T_Alternatives -> Inh_Alternatives -> (Syn_Alternatives ) +wrap_Alternatives (T_Alternatives act) (Inh_Alternatives _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternatives_vIn4 _lhsIopTable _lhsIresolveErrors + (T_Alternatives_vOut4 _lhsOresolveErrors _lhsOself) <- return (inv_Alternatives_s5 sem arg) + return (Syn_Alternatives _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternatives #-} +sem_Alternatives :: Alternatives -> T_Alternatives +sem_Alternatives list = Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) + +-- semantic domain +newtype T_Alternatives = T_Alternatives { + attach_T_Alternatives :: Identity (T_Alternatives_s5 ) + } +newtype T_Alternatives_s5 = C_Alternatives_s5 { + inv_Alternatives_s5 :: (T_Alternatives_v4 ) + } +data T_Alternatives_s6 = C_Alternatives_s6 +type T_Alternatives_v4 = (T_Alternatives_vIn4 ) -> (T_Alternatives_vOut4 ) +data T_Alternatives_vIn4 = T_Alternatives_vIn4 (OperatorTable) ( [ResolveError] ) +data T_Alternatives_vOut4 = T_Alternatives_vOut4 ( [ResolveError] ) (Alternatives) +{-# NOINLINE sem_Alternatives_Cons #-} +sem_Alternatives_Cons :: T_Alternative -> T_Alternatives -> T_Alternatives +sem_Alternatives_Cons arg_hd_ arg_tl_ = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 _lhsIopTable _lhsIresolveErrors) -> ( let + _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_hd_)) + _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_tl_)) + (T_Alternative_vOut1 _hdIresolveErrors _hdIself) = inv_Alternative_s2 _hdX2 (T_Alternative_vIn1 _hdOopTable _hdOresolveErrors) + (T_Alternatives_vOut4 _tlIresolveErrors _tlIself) = inv_Alternatives_s5 _tlX5 (T_Alternatives_vIn4 _tlOopTable _tlOresolveErrors) + _self = rule18 _hdIself _tlIself + _lhsOself :: Alternatives + _lhsOself = rule19 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule20 _tlIresolveErrors + _hdOopTable = rule21 _lhsIopTable + _hdOresolveErrors = rule22 _lhsIresolveErrors + _tlOopTable = rule23 _lhsIopTable + _tlOresolveErrors = rule24 _hdIresolveErrors + __result_ = T_Alternatives_vOut4 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule18 #-} + rule18 = \ ((_hdIself) :: Alternative) ((_tlIself) :: Alternatives) -> + (:) _hdIself _tlIself + {-# INLINE rule19 #-} + rule19 = \ _self -> + _self + {-# INLINE rule20 #-} + rule20 = \ ((_tlIresolveErrors) :: [ResolveError] ) -> + _tlIresolveErrors + {-# INLINE rule21 #-} + rule21 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule22 #-} + rule22 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule23 #-} + rule23 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule24 #-} + rule24 = \ ((_hdIresolveErrors) :: [ResolveError] ) -> + _hdIresolveErrors +{-# NOINLINE sem_Alternatives_Nil #-} +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule25 () + _lhsOself :: Alternatives + _lhsOself = rule26 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule27 _lhsIresolveErrors + __result_ = T_Alternatives_vOut4 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule25 #-} + rule25 = \ (_ :: ()) -> + [] + {-# INLINE rule26 #-} + rule26 = \ _self -> + _self + {-# INLINE rule27 #-} + rule27 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- AnnotatedType ----------------------------------------------- +-- wrapper +data Inh_AnnotatedType = Inh_AnnotatedType { } +data Syn_AnnotatedType = Syn_AnnotatedType { self_Syn_AnnotatedType :: (AnnotatedType) } +{-# INLINABLE wrap_AnnotatedType #-} +wrap_AnnotatedType :: T_AnnotatedType -> Inh_AnnotatedType -> (Syn_AnnotatedType ) +wrap_AnnotatedType (T_AnnotatedType act) (Inh_AnnotatedType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedType_vIn7 + (T_AnnotatedType_vOut7 _lhsOself) <- return (inv_AnnotatedType_s8 sem arg) + return (Syn_AnnotatedType _lhsOself) + ) + +-- cata +{-# INLINE sem_AnnotatedType #-} +sem_AnnotatedType :: AnnotatedType -> T_AnnotatedType +sem_AnnotatedType ( AnnotatedType_AnnotatedType range_ strict_ type_ ) = sem_AnnotatedType_AnnotatedType ( sem_Range range_ ) strict_ ( sem_Type type_ ) + +-- semantic domain +newtype T_AnnotatedType = T_AnnotatedType { + attach_T_AnnotatedType :: Identity (T_AnnotatedType_s8 ) + } +newtype T_AnnotatedType_s8 = C_AnnotatedType_s8 { + inv_AnnotatedType_s8 :: (T_AnnotatedType_v7 ) + } +data T_AnnotatedType_s9 = C_AnnotatedType_s9 +type T_AnnotatedType_v7 = (T_AnnotatedType_vIn7 ) -> (T_AnnotatedType_vOut7 ) +data T_AnnotatedType_vIn7 = T_AnnotatedType_vIn7 +data T_AnnotatedType_vOut7 = T_AnnotatedType_vOut7 (AnnotatedType) +{-# NOINLINE sem_AnnotatedType_AnnotatedType #-} +sem_AnnotatedType_AnnotatedType :: T_Range -> (Bool) -> T_Type -> T_AnnotatedType +sem_AnnotatedType_AnnotatedType arg_range_ arg_strict_ arg_type_ = T_AnnotatedType (return st8) where + {-# NOINLINE st8 #-} + st8 = let + v7 :: T_AnnotatedType_v7 + v7 = \ (T_AnnotatedType_vIn7 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule28 _rangeIself _typeIself arg_strict_ + _lhsOself :: AnnotatedType + _lhsOself = rule29 _self + __result_ = T_AnnotatedType_vOut7 _lhsOself + in __result_ ) + in C_AnnotatedType_s8 v7 + {-# INLINE rule28 #-} + rule28 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) strict_ -> + AnnotatedType_AnnotatedType _rangeIself strict_ _typeIself + {-# INLINE rule29 #-} + rule29 = \ _self -> + _self + +-- AnnotatedTypes ---------------------------------------------- +-- wrapper +data Inh_AnnotatedTypes = Inh_AnnotatedTypes { } +data Syn_AnnotatedTypes = Syn_AnnotatedTypes { self_Syn_AnnotatedTypes :: (AnnotatedTypes) } +{-# INLINABLE wrap_AnnotatedTypes #-} +wrap_AnnotatedTypes :: T_AnnotatedTypes -> Inh_AnnotatedTypes -> (Syn_AnnotatedTypes ) +wrap_AnnotatedTypes (T_AnnotatedTypes act) (Inh_AnnotatedTypes ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedTypes_vIn10 + (T_AnnotatedTypes_vOut10 _lhsOself) <- return (inv_AnnotatedTypes_s11 sem arg) + return (Syn_AnnotatedTypes _lhsOself) + ) + +-- cata +{-# NOINLINE sem_AnnotatedTypes #-} +sem_AnnotatedTypes :: AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes list = Prelude.foldr sem_AnnotatedTypes_Cons sem_AnnotatedTypes_Nil (Prelude.map sem_AnnotatedType list) + +-- semantic domain +newtype T_AnnotatedTypes = T_AnnotatedTypes { + attach_T_AnnotatedTypes :: Identity (T_AnnotatedTypes_s11 ) + } +newtype T_AnnotatedTypes_s11 = C_AnnotatedTypes_s11 { + inv_AnnotatedTypes_s11 :: (T_AnnotatedTypes_v10 ) + } +data T_AnnotatedTypes_s12 = C_AnnotatedTypes_s12 +type T_AnnotatedTypes_v10 = (T_AnnotatedTypes_vIn10 ) -> (T_AnnotatedTypes_vOut10 ) +data T_AnnotatedTypes_vIn10 = T_AnnotatedTypes_vIn10 +data T_AnnotatedTypes_vOut10 = T_AnnotatedTypes_vOut10 (AnnotatedTypes) +{-# NOINLINE sem_AnnotatedTypes_Cons #-} +sem_AnnotatedTypes_Cons :: T_AnnotatedType -> T_AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes_Cons arg_hd_ arg_tl_ = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _hdX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_hd_)) + _tlX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_tl_)) + (T_AnnotatedType_vOut7 _hdIself) = inv_AnnotatedType_s8 _hdX8 (T_AnnotatedType_vIn7 ) + (T_AnnotatedTypes_vOut10 _tlIself) = inv_AnnotatedTypes_s11 _tlX11 (T_AnnotatedTypes_vIn10 ) + _self = rule30 _hdIself _tlIself + _lhsOself :: AnnotatedTypes + _lhsOself = rule31 _self + __result_ = T_AnnotatedTypes_vOut10 _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule30 #-} + rule30 = \ ((_hdIself) :: AnnotatedType) ((_tlIself) :: AnnotatedTypes) -> + (:) _hdIself _tlIself + {-# INLINE rule31 #-} + rule31 = \ _self -> + _self +{-# NOINLINE sem_AnnotatedTypes_Nil #-} +sem_AnnotatedTypes_Nil :: T_AnnotatedTypes +sem_AnnotatedTypes_Nil = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _self = rule32 () + _lhsOself :: AnnotatedTypes + _lhsOself = rule33 _self + __result_ = T_AnnotatedTypes_vOut10 _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule32 #-} + rule32 = \ (_ :: ()) -> + [] + {-# INLINE rule33 #-} + rule33 = \ _self -> + _self + +-- Body -------------------------------------------------------- +-- wrapper +data Inh_Body = Inh_Body { opTable_Inh_Body :: (OperatorTable), resolveErrors_Inh_Body :: ( [ResolveError] ) } +data Syn_Body = Syn_Body { resolveErrors_Syn_Body :: ( [ResolveError] ), self_Syn_Body :: (Body) } +{-# INLINABLE wrap_Body #-} +wrap_Body :: T_Body -> Inh_Body -> (Syn_Body ) +wrap_Body (T_Body act) (Inh_Body _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Body_vIn13 _lhsIopTable _lhsIresolveErrors + (T_Body_vOut13 _lhsOresolveErrors _lhsOself) <- return (inv_Body_s14 sem arg) + return (Syn_Body _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Body #-} +sem_Body :: Body -> T_Body +sem_Body ( Body_Hole range_ id_ ) = sem_Body_Hole ( sem_Range range_ ) id_ +sem_Body ( Body_Body range_ importdeclarations_ declarations_ ) = sem_Body_Body ( sem_Range range_ ) ( sem_ImportDeclarations importdeclarations_ ) ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_Body = T_Body { + attach_T_Body :: Identity (T_Body_s14 ) + } +newtype T_Body_s14 = C_Body_s14 { + inv_Body_s14 :: (T_Body_v13 ) + } +data T_Body_s15 = C_Body_s15 +type T_Body_v13 = (T_Body_vIn13 ) -> (T_Body_vOut13 ) +data T_Body_vIn13 = T_Body_vIn13 (OperatorTable) ( [ResolveError] ) +data T_Body_vOut13 = T_Body_vOut13 ( [ResolveError] ) (Body) +{-# NOINLINE sem_Body_Hole #-} +sem_Body_Hole :: T_Range -> (Integer) -> T_Body +sem_Body_Hole arg_range_ arg_id_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule34 _rangeIself arg_id_ + _lhsOself :: Body + _lhsOself = rule35 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule36 _lhsIresolveErrors + __result_ = T_Body_vOut13 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule34 #-} + rule34 = \ ((_rangeIself) :: Range) id_ -> + Body_Hole _rangeIself id_ + {-# INLINE rule35 #-} + rule35 = \ _self -> + _self + {-# INLINE rule36 #-} + rule36 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Body_Body #-} +sem_Body_Body :: T_Range -> T_ImportDeclarations -> T_Declarations -> T_Body +sem_Body_Body arg_range_ arg_importdeclarations_ arg_declarations_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importdeclarationsX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_importdeclarations_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ImportDeclarations_vOut73 _importdeclarationsIself) = inv_ImportDeclarations_s74 _importdeclarationsX74 (T_ImportDeclarations_vIn73 ) + (T_Declarations_vOut31 _declarationsIresolveErrors _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOopTable _declarationsOresolveErrors) + _self = rule37 _declarationsIself _importdeclarationsIself _rangeIself + _lhsOself :: Body + _lhsOself = rule38 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule39 _declarationsIresolveErrors + _declarationsOopTable = rule40 _lhsIopTable + _declarationsOresolveErrors = rule41 _lhsIresolveErrors + __result_ = T_Body_vOut13 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule37 #-} + rule37 = \ ((_declarationsIself) :: Declarations) ((_importdeclarationsIself) :: ImportDeclarations) ((_rangeIself) :: Range) -> + Body_Body _rangeIself _importdeclarationsIself _declarationsIself + {-# INLINE rule38 #-} + rule38 = \ _self -> + _self + {-# INLINE rule39 #-} + rule39 = \ ((_declarationsIresolveErrors) :: [ResolveError] ) -> + _declarationsIresolveErrors + {-# INLINE rule40 #-} + rule40 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule41 #-} + rule41 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Constructor ------------------------------------------------- +-- wrapper +data Inh_Constructor = Inh_Constructor { } +data Syn_Constructor = Syn_Constructor { self_Syn_Constructor :: (Constructor) } +{-# INLINABLE wrap_Constructor #-} +wrap_Constructor :: T_Constructor -> Inh_Constructor -> (Syn_Constructor ) +wrap_Constructor (T_Constructor act) (Inh_Constructor ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructor_vIn16 + (T_Constructor_vOut16 _lhsOself) <- return (inv_Constructor_s17 sem arg) + return (Syn_Constructor _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructor #-} +sem_Constructor :: Constructor -> T_Constructor +sem_Constructor ( Constructor_Constructor range_ constructor_ types_ ) = sem_Constructor_Constructor ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_AnnotatedTypes types_ ) +sem_Constructor ( Constructor_Infix range_ leftType_ constructorOperator_ rightType_ ) = sem_Constructor_Infix ( sem_Range range_ ) ( sem_AnnotatedType leftType_ ) ( sem_Name constructorOperator_ ) ( sem_AnnotatedType rightType_ ) +sem_Constructor ( Constructor_Record range_ constructor_ fieldDeclarations_ ) = sem_Constructor_Record ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_FieldDeclarations fieldDeclarations_ ) + +-- semantic domain +newtype T_Constructor = T_Constructor { + attach_T_Constructor :: Identity (T_Constructor_s17 ) + } +newtype T_Constructor_s17 = C_Constructor_s17 { + inv_Constructor_s17 :: (T_Constructor_v16 ) + } +data T_Constructor_s18 = C_Constructor_s18 +type T_Constructor_v16 = (T_Constructor_vIn16 ) -> (T_Constructor_vOut16 ) +data T_Constructor_vIn16 = T_Constructor_vIn16 +data T_Constructor_vOut16 = T_Constructor_vOut16 (Constructor) +{-# NOINLINE sem_Constructor_Constructor #-} +sem_Constructor_Constructor :: T_Range -> T_Name -> T_AnnotatedTypes -> T_Constructor +sem_Constructor_Constructor arg_range_ arg_constructor_ arg_types_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _typesX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_AnnotatedTypes_vOut10 _typesIself) = inv_AnnotatedTypes_s11 _typesX11 (T_AnnotatedTypes_vIn10 ) + _self = rule42 _constructorIself _rangeIself _typesIself + _lhsOself :: Constructor + _lhsOself = rule43 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule42 #-} + rule42 = \ ((_constructorIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: AnnotatedTypes) -> + Constructor_Constructor _rangeIself _constructorIself _typesIself + {-# INLINE rule43 #-} + rule43 = \ _self -> + _self +{-# NOINLINE sem_Constructor_Infix #-} +sem_Constructor_Infix :: T_Range -> T_AnnotatedType -> T_Name -> T_AnnotatedType -> T_Constructor +sem_Constructor_Infix arg_range_ arg_leftType_ arg_constructorOperator_ arg_rightType_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_leftType_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_rightType_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_AnnotatedType_vOut7 _leftTypeIself) = inv_AnnotatedType_s8 _leftTypeX8 (T_AnnotatedType_vIn7 ) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_AnnotatedType_vOut7 _rightTypeIself) = inv_AnnotatedType_s8 _rightTypeX8 (T_AnnotatedType_vIn7 ) + _self = rule44 _constructorOperatorIself _leftTypeIself _rangeIself _rightTypeIself + _lhsOself :: Constructor + _lhsOself = rule45 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule44 #-} + rule44 = \ ((_constructorOperatorIself) :: Name) ((_leftTypeIself) :: AnnotatedType) ((_rangeIself) :: Range) ((_rightTypeIself) :: AnnotatedType) -> + Constructor_Infix _rangeIself _leftTypeIself _constructorOperatorIself _rightTypeIself + {-# INLINE rule45 #-} + rule45 = \ _self -> + _self +{-# NOINLINE sem_Constructor_Record #-} +sem_Constructor_Record :: T_Range -> T_Name -> T_FieldDeclarations -> T_Constructor +sem_Constructor_Record arg_range_ arg_constructor_ arg_fieldDeclarations_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _fieldDeclarationsX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_fieldDeclarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_FieldDeclarations_vOut49 _fieldDeclarationsIself) = inv_FieldDeclarations_s50 _fieldDeclarationsX50 (T_FieldDeclarations_vIn49 ) + _self = rule46 _constructorIself _fieldDeclarationsIself _rangeIself + _lhsOself :: Constructor + _lhsOself = rule47 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule46 #-} + rule46 = \ ((_constructorIself) :: Name) ((_fieldDeclarationsIself) :: FieldDeclarations) ((_rangeIself) :: Range) -> + Constructor_Record _rangeIself _constructorIself _fieldDeclarationsIself + {-# INLINE rule47 #-} + rule47 = \ _self -> + _self + +-- Constructors ------------------------------------------------ +-- wrapper +data Inh_Constructors = Inh_Constructors { } +data Syn_Constructors = Syn_Constructors { self_Syn_Constructors :: (Constructors) } +{-# INLINABLE wrap_Constructors #-} +wrap_Constructors :: T_Constructors -> Inh_Constructors -> (Syn_Constructors ) +wrap_Constructors (T_Constructors act) (Inh_Constructors ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructors_vIn19 + (T_Constructors_vOut19 _lhsOself) <- return (inv_Constructors_s20 sem arg) + return (Syn_Constructors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructors #-} +sem_Constructors :: Constructors -> T_Constructors +sem_Constructors list = Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list) + +-- semantic domain +newtype T_Constructors = T_Constructors { + attach_T_Constructors :: Identity (T_Constructors_s20 ) + } +newtype T_Constructors_s20 = C_Constructors_s20 { + inv_Constructors_s20 :: (T_Constructors_v19 ) + } +data T_Constructors_s21 = C_Constructors_s21 +type T_Constructors_v19 = (T_Constructors_vIn19 ) -> (T_Constructors_vOut19 ) +data T_Constructors_vIn19 = T_Constructors_vIn19 +data T_Constructors_vOut19 = T_Constructors_vOut19 (Constructors) +{-# NOINLINE sem_Constructors_Cons #-} +sem_Constructors_Cons :: T_Constructor -> T_Constructors -> T_Constructors +sem_Constructors_Cons arg_hd_ arg_tl_ = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 ) -> ( let + _hdX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_hd_)) + _tlX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_tl_)) + (T_Constructor_vOut16 _hdIself) = inv_Constructor_s17 _hdX17 (T_Constructor_vIn16 ) + (T_Constructors_vOut19 _tlIself) = inv_Constructors_s20 _tlX20 (T_Constructors_vIn19 ) + _self = rule48 _hdIself _tlIself + _lhsOself :: Constructors + _lhsOself = rule49 _self + __result_ = T_Constructors_vOut19 _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule48 #-} + rule48 = \ ((_hdIself) :: Constructor) ((_tlIself) :: Constructors) -> + (:) _hdIself _tlIself + {-# INLINE rule49 #-} + rule49 = \ _self -> + _self +{-# NOINLINE sem_Constructors_Nil #-} +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 ) -> ( let + _self = rule50 () + _lhsOself :: Constructors + _lhsOself = rule51 _self + __result_ = T_Constructors_vOut19 _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule50 #-} + rule50 = \ (_ :: ()) -> + [] + {-# INLINE rule51 #-} + rule51 = \ _self -> + _self + +-- ContextItem ------------------------------------------------- +-- wrapper +data Inh_ContextItem = Inh_ContextItem { } +data Syn_ContextItem = Syn_ContextItem { self_Syn_ContextItem :: (ContextItem) } +{-# INLINABLE wrap_ContextItem #-} +wrap_ContextItem :: T_ContextItem -> Inh_ContextItem -> (Syn_ContextItem ) +wrap_ContextItem (T_ContextItem act) (Inh_ContextItem ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItem_vIn22 + (T_ContextItem_vOut22 _lhsOself) <- return (inv_ContextItem_s23 sem arg) + return (Syn_ContextItem _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItem #-} +sem_ContextItem :: ContextItem -> T_ContextItem +sem_ContextItem ( ContextItem_ContextItem range_ name_ types_ ) = sem_ContextItem_ContextItem ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Types types_ ) + +-- semantic domain +newtype T_ContextItem = T_ContextItem { + attach_T_ContextItem :: Identity (T_ContextItem_s23 ) + } +newtype T_ContextItem_s23 = C_ContextItem_s23 { + inv_ContextItem_s23 :: (T_ContextItem_v22 ) + } +data T_ContextItem_s24 = C_ContextItem_s24 +type T_ContextItem_v22 = (T_ContextItem_vIn22 ) -> (T_ContextItem_vOut22 ) +data T_ContextItem_vIn22 = T_ContextItem_vIn22 +data T_ContextItem_vOut22 = T_ContextItem_vOut22 (ContextItem) +{-# NOINLINE sem_ContextItem_ContextItem #-} +sem_ContextItem_ContextItem :: T_Range -> T_Name -> T_Types -> T_ContextItem +sem_ContextItem_ContextItem arg_range_ arg_name_ arg_types_ = T_ContextItem (return st23) where + {-# NOINLINE st23 #-} + st23 = let + v22 :: T_ContextItem_v22 + v22 = \ (T_ContextItem_vIn22 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _self = rule52 _nameIself _rangeIself _typesIself + _lhsOself :: ContextItem + _lhsOself = rule53 _self + __result_ = T_ContextItem_vOut22 _lhsOself + in __result_ ) + in C_ContextItem_s23 v22 + {-# INLINE rule52 #-} + rule52 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + ContextItem_ContextItem _rangeIself _nameIself _typesIself + {-# INLINE rule53 #-} + rule53 = \ _self -> + _self + +-- ContextItems ------------------------------------------------ +-- wrapper +data Inh_ContextItems = Inh_ContextItems { } +data Syn_ContextItems = Syn_ContextItems { self_Syn_ContextItems :: (ContextItems) } +{-# INLINABLE wrap_ContextItems #-} +wrap_ContextItems :: T_ContextItems -> Inh_ContextItems -> (Syn_ContextItems ) +wrap_ContextItems (T_ContextItems act) (Inh_ContextItems ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItems_vIn25 + (T_ContextItems_vOut25 _lhsOself) <- return (inv_ContextItems_s26 sem arg) + return (Syn_ContextItems _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItems #-} +sem_ContextItems :: ContextItems -> T_ContextItems +sem_ContextItems list = Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list) + +-- semantic domain +newtype T_ContextItems = T_ContextItems { + attach_T_ContextItems :: Identity (T_ContextItems_s26 ) + } +newtype T_ContextItems_s26 = C_ContextItems_s26 { + inv_ContextItems_s26 :: (T_ContextItems_v25 ) + } +data T_ContextItems_s27 = C_ContextItems_s27 +type T_ContextItems_v25 = (T_ContextItems_vIn25 ) -> (T_ContextItems_vOut25 ) +data T_ContextItems_vIn25 = T_ContextItems_vIn25 +data T_ContextItems_vOut25 = T_ContextItems_vOut25 (ContextItems) +{-# NOINLINE sem_ContextItems_Cons #-} +sem_ContextItems_Cons :: T_ContextItem -> T_ContextItems -> T_ContextItems +sem_ContextItems_Cons arg_hd_ arg_tl_ = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _hdX23 = Control.Monad.Identity.runIdentity (attach_T_ContextItem (arg_hd_)) + _tlX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_tl_)) + (T_ContextItem_vOut22 _hdIself) = inv_ContextItem_s23 _hdX23 (T_ContextItem_vIn22 ) + (T_ContextItems_vOut25 _tlIself) = inv_ContextItems_s26 _tlX26 (T_ContextItems_vIn25 ) + _self = rule54 _hdIself _tlIself + _lhsOself :: ContextItems + _lhsOself = rule55 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule54 #-} + rule54 = \ ((_hdIself) :: ContextItem) ((_tlIself) :: ContextItems) -> + (:) _hdIself _tlIself + {-# INLINE rule55 #-} + rule55 = \ _self -> + _self +{-# NOINLINE sem_ContextItems_Nil #-} +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _self = rule56 () + _lhsOself :: ContextItems + _lhsOself = rule57 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule56 #-} + rule56 = \ (_ :: ()) -> + [] + {-# INLINE rule57 #-} + rule57 = \ _self -> + _self + +-- Declaration ------------------------------------------------- +-- wrapper +data Inh_Declaration = Inh_Declaration { opTable_Inh_Declaration :: (OperatorTable), resolveErrors_Inh_Declaration :: ( [ResolveError] ) } +data Syn_Declaration = Syn_Declaration { resolveErrors_Syn_Declaration :: ( [ResolveError] ), self_Syn_Declaration :: (Declaration) } +{-# INLINABLE wrap_Declaration #-} +wrap_Declaration :: T_Declaration -> Inh_Declaration -> (Syn_Declaration ) +wrap_Declaration (T_Declaration act) (Inh_Declaration _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors + (T_Declaration_vOut28 _lhsOresolveErrors _lhsOself) <- return (inv_Declaration_s29 sem arg) + return (Syn_Declaration _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declaration #-} +sem_Declaration :: Declaration -> T_Declaration +sem_Declaration ( Declaration_Hole range_ id_ ) = sem_Declaration_Hole ( sem_Range range_ ) id_ +sem_Declaration ( Declaration_Type range_ simpletype_ type_ ) = sem_Declaration_Type ( sem_Range range_ ) ( sem_SimpleType simpletype_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Data range_ context_ simpletype_ constructors_ derivings_ ) = sem_Declaration_Data ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructors constructors_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Newtype range_ context_ simpletype_ constructor_ derivings_ ) = sem_Declaration_Newtype ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructor constructor_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Class range_ context_ simpletype_ where_ ) = sem_Declaration_Class ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Instance range_ context_ name_ types_ where_ ) = sem_Declaration_Instance ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Name name_ ) ( sem_Types types_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Default range_ types_ ) = sem_Declaration_Default ( sem_Range range_ ) ( sem_Types types_ ) +sem_Declaration ( Declaration_FunctionBindings range_ bindings_ ) = sem_Declaration_FunctionBindings ( sem_Range range_ ) ( sem_FunctionBindings bindings_ ) +sem_Declaration ( Declaration_PatternBinding range_ pattern_ righthandside_ ) = sem_Declaration_PatternBinding ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Declaration ( Declaration_TypeSignature range_ names_ type_ ) = sem_Declaration_TypeSignature ( sem_Range range_ ) ( sem_Names names_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Fixity range_ fixity_ priority_ operators_ ) = sem_Declaration_Fixity ( sem_Range range_ ) ( sem_Fixity fixity_ ) ( sem_MaybeInt priority_ ) ( sem_Names operators_ ) +sem_Declaration ( Declaration_Empty range_ ) = sem_Declaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Declaration = T_Declaration { + attach_T_Declaration :: Identity (T_Declaration_s29 ) + } +newtype T_Declaration_s29 = C_Declaration_s29 { + inv_Declaration_s29 :: (T_Declaration_v28 ) + } +data T_Declaration_s30 = C_Declaration_s30 +type T_Declaration_v28 = (T_Declaration_vIn28 ) -> (T_Declaration_vOut28 ) +data T_Declaration_vIn28 = T_Declaration_vIn28 (OperatorTable) ( [ResolveError] ) +data T_Declaration_vOut28 = T_Declaration_vOut28 ( [ResolveError] ) (Declaration) +{-# NOINLINE sem_Declaration_Hole #-} +sem_Declaration_Hole :: T_Range -> (Integer) -> T_Declaration +sem_Declaration_Hole arg_range_ arg_id_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule58 _rangeIself arg_id_ + _lhsOself :: Declaration + _lhsOself = rule59 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule60 _lhsIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule58 #-} + rule58 = \ ((_rangeIself) :: Range) id_ -> + Declaration_Hole _rangeIself id_ + {-# INLINE rule59 #-} + rule59 = \ _self -> + _self + {-# INLINE rule60 #-} + rule60 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Declaration_Type #-} +sem_Declaration_Type :: T_Range -> T_SimpleType -> T_Type -> T_Declaration +sem_Declaration_Type arg_range_ arg_simpletype_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule61 _rangeIself _simpletypeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule62 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule63 _lhsIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule61 #-} + rule61 = \ ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_typeIself) :: Type) -> + Declaration_Type _rangeIself _simpletypeIself _typeIself + {-# INLINE rule62 #-} + rule62 = \ _self -> + _self + {-# INLINE rule63 #-} + rule63 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Declaration_Data #-} +sem_Declaration_Data :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructors -> T_Names -> T_Declaration +sem_Declaration_Data arg_range_ arg_context_ arg_simpletype_ arg_constructors_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorsX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_constructors_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructors_vOut19 _constructorsIself) = inv_Constructors_s20 _constructorsX20 (T_Constructors_vIn19 ) + (T_Names_vOut115 _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _self = rule64 _constructorsIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule65 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule66 _lhsIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule64 #-} + rule64 = \ ((_constructorsIself) :: Constructors) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Data _rangeIself _contextIself _simpletypeIself _constructorsIself _derivingsIself + {-# INLINE rule65 #-} + rule65 = \ _self -> + _self + {-# INLINE rule66 #-} + rule66 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Declaration_Newtype #-} +sem_Declaration_Newtype :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructor -> T_Names -> T_Declaration +sem_Declaration_Newtype arg_range_ arg_context_ arg_simpletype_ arg_constructor_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_constructor_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructor_vOut16 _constructorIself) = inv_Constructor_s17 _constructorX17 (T_Constructor_vIn16 ) + (T_Names_vOut115 _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _self = rule67 _constructorIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule68 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule69 _lhsIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule67 #-} + rule67 = \ ((_constructorIself) :: Constructor) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Newtype _rangeIself _contextIself _simpletypeIself _constructorIself _derivingsIself + {-# INLINE rule68 #-} + rule68 = \ _self -> + _self + {-# INLINE rule69 #-} + rule69 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Declaration_Class #-} +sem_Declaration_Class :: T_Range -> T_ContextItems -> T_SimpleType -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Class arg_range_ arg_context_ arg_simpletype_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_MaybeDeclarations_vOut88 _whereIresolveErrors _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOopTable _whereOresolveErrors) + _self = rule70 _contextIself _rangeIself _simpletypeIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule71 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule72 _whereIresolveErrors + _whereOopTable = rule73 _lhsIopTable + _whereOresolveErrors = rule74 _lhsIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule70 #-} + rule70 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Class _rangeIself _contextIself _simpletypeIself _whereIself + {-# INLINE rule71 #-} + rule71 = \ _self -> + _self + {-# INLINE rule72 #-} + rule72 = \ ((_whereIresolveErrors) :: [ResolveError] ) -> + _whereIresolveErrors + {-# INLINE rule73 #-} + rule73 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule74 #-} + rule74 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Declaration_Instance #-} +sem_Declaration_Instance :: T_Range -> T_ContextItems -> T_Name -> T_Types -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Instance arg_range_ arg_context_ arg_name_ arg_types_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + (T_MaybeDeclarations_vOut88 _whereIresolveErrors _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOopTable _whereOresolveErrors) + _self = rule75 _contextIself _nameIself _rangeIself _typesIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule76 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule77 _whereIresolveErrors + _whereOopTable = rule78 _lhsIopTable + _whereOresolveErrors = rule79 _lhsIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule75 #-} + rule75 = \ ((_contextIself) :: ContextItems) ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Instance _rangeIself _contextIself _nameIself _typesIself _whereIself + {-# INLINE rule76 #-} + rule76 = \ _self -> + _self + {-# INLINE rule77 #-} + rule77 = \ ((_whereIresolveErrors) :: [ResolveError] ) -> + _whereIresolveErrors + {-# INLINE rule78 #-} + rule78 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule79 #-} + rule79 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Declaration_Default #-} +sem_Declaration_Default :: T_Range -> T_Types -> T_Declaration +sem_Declaration_Default arg_range_ arg_types_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _self = rule80 _rangeIself _typesIself + _lhsOself :: Declaration + _lhsOself = rule81 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule82 _lhsIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule80 #-} + rule80 = \ ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + Declaration_Default _rangeIself _typesIself + {-# INLINE rule81 #-} + rule81 = \ _self -> + _self + {-# INLINE rule82 #-} + rule82 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Declaration_FunctionBindings #-} +sem_Declaration_FunctionBindings :: T_Range -> T_FunctionBindings -> T_Declaration +sem_Declaration_FunctionBindings arg_range_ arg_bindings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _bindingsX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_bindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBindings_vOut58 _bindingsIresolveErrors _bindingsIself) = inv_FunctionBindings_s59 _bindingsX59 (T_FunctionBindings_vIn58 _bindingsOopTable _bindingsOresolveErrors) + _self = rule83 _bindingsIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule84 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule85 _bindingsIresolveErrors + _bindingsOopTable = rule86 _lhsIopTable + _bindingsOresolveErrors = rule87 _lhsIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule83 #-} + rule83 = \ ((_bindingsIself) :: FunctionBindings) ((_rangeIself) :: Range) -> + Declaration_FunctionBindings _rangeIself _bindingsIself + {-# INLINE rule84 #-} + rule84 = \ _self -> + _self + {-# INLINE rule85 #-} + rule85 = \ ((_bindingsIresolveErrors) :: [ResolveError] ) -> + _bindingsIresolveErrors + {-# INLINE rule86 #-} + rule86 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule87 #-} + rule87 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Declaration_PatternBinding #-} +sem_Declaration_PatternBinding :: T_Range -> T_Pattern -> T_RightHandSide -> T_Declaration +sem_Declaration_PatternBinding arg_range_ arg_pattern_ arg_righthandside_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIresolveErrors _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOopTable _patternOresolveErrors) + (T_RightHandSide_vOut148 _righthandsideIresolveErrors _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOopTable _righthandsideOresolveErrors) + _self = rule88 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Declaration + _lhsOself = rule89 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule90 _righthandsideIresolveErrors + _patternOopTable = rule91 _lhsIopTable + _patternOresolveErrors = rule92 _lhsIresolveErrors + _righthandsideOopTable = rule93 _lhsIopTable + _righthandsideOresolveErrors = rule94 _patternIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule88 #-} + rule88 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Declaration_PatternBinding _rangeIself _patternIself _righthandsideIself + {-# INLINE rule89 #-} + rule89 = \ _self -> + _self + {-# INLINE rule90 #-} + rule90 = \ ((_righthandsideIresolveErrors) :: [ResolveError] ) -> + _righthandsideIresolveErrors + {-# INLINE rule91 #-} + rule91 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule92 #-} + rule92 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule93 #-} + rule93 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule94 #-} + rule94 = \ ((_patternIresolveErrors) :: [ResolveError] ) -> + _patternIresolveErrors +{-# NOINLINE sem_Declaration_TypeSignature #-} +sem_Declaration_TypeSignature :: T_Range -> T_Names -> T_Type -> T_Declaration +sem_Declaration_TypeSignature arg_range_ arg_names_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule95 _namesIself _rangeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule96 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule97 _lhsIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule95 #-} + rule95 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Declaration_TypeSignature _rangeIself _namesIself _typeIself + {-# INLINE rule96 #-} + rule96 = \ _self -> + _self + {-# INLINE rule97 #-} + rule97 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Declaration_Fixity #-} +sem_Declaration_Fixity :: T_Range -> T_Fixity -> T_MaybeInt -> T_Names -> T_Declaration +sem_Declaration_Fixity arg_range_ arg_fixity_ arg_priority_ arg_operators_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fixityX53 = Control.Monad.Identity.runIdentity (attach_T_Fixity (arg_fixity_)) + _priorityX101 = Control.Monad.Identity.runIdentity (attach_T_MaybeInt (arg_priority_)) + _operatorsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_operators_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Fixity_vOut52 _fixityIself) = inv_Fixity_s53 _fixityX53 (T_Fixity_vIn52 ) + (T_MaybeInt_vOut100 _priorityIself) = inv_MaybeInt_s101 _priorityX101 (T_MaybeInt_vIn100 ) + (T_Names_vOut115 _operatorsIself) = inv_Names_s116 _operatorsX116 (T_Names_vIn115 ) + _self = rule98 _fixityIself _operatorsIself _priorityIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule99 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule100 _lhsIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule98 #-} + rule98 = \ ((_fixityIself) :: Fixity) ((_operatorsIself) :: Names) ((_priorityIself) :: MaybeInt) ((_rangeIself) :: Range) -> + Declaration_Fixity _rangeIself _fixityIself _priorityIself _operatorsIself + {-# INLINE rule99 #-} + rule99 = \ _self -> + _self + {-# INLINE rule100 #-} + rule100 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Declaration_Empty #-} +sem_Declaration_Empty :: T_Range -> T_Declaration +sem_Declaration_Empty arg_range_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule101 _rangeIself + _lhsOself :: Declaration + _lhsOself = rule102 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule103 _lhsIresolveErrors + __result_ = T_Declaration_vOut28 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule101 #-} + rule101 = \ ((_rangeIself) :: Range) -> + Declaration_Empty _rangeIself + {-# INLINE rule102 #-} + rule102 = \ _self -> + _self + {-# INLINE rule103 #-} + rule103 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Declarations ------------------------------------------------ +-- wrapper +data Inh_Declarations = Inh_Declarations { opTable_Inh_Declarations :: (OperatorTable), resolveErrors_Inh_Declarations :: ( [ResolveError] ) } +data Syn_Declarations = Syn_Declarations { resolveErrors_Syn_Declarations :: ( [ResolveError] ), self_Syn_Declarations :: (Declarations) } +{-# INLINABLE wrap_Declarations #-} +wrap_Declarations :: T_Declarations -> Inh_Declarations -> (Syn_Declarations ) +wrap_Declarations (T_Declarations act) (Inh_Declarations _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declarations_vIn31 _lhsIopTable _lhsIresolveErrors + (T_Declarations_vOut31 _lhsOresolveErrors _lhsOself) <- return (inv_Declarations_s32 sem arg) + return (Syn_Declarations _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declarations #-} +sem_Declarations :: Declarations -> T_Declarations +sem_Declarations list = Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list) + +-- semantic domain +newtype T_Declarations = T_Declarations { + attach_T_Declarations :: Identity (T_Declarations_s32 ) + } +newtype T_Declarations_s32 = C_Declarations_s32 { + inv_Declarations_s32 :: (T_Declarations_v31 ) + } +data T_Declarations_s33 = C_Declarations_s33 +type T_Declarations_v31 = (T_Declarations_vIn31 ) -> (T_Declarations_vOut31 ) +data T_Declarations_vIn31 = T_Declarations_vIn31 (OperatorTable) ( [ResolveError] ) +data T_Declarations_vOut31 = T_Declarations_vOut31 ( [ResolveError] ) (Declarations) +{-# NOINLINE sem_Declarations_Cons #-} +sem_Declarations_Cons :: T_Declaration -> T_Declarations -> T_Declarations +sem_Declarations_Cons arg_hd_ arg_tl_ = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 _lhsIopTable _lhsIresolveErrors) -> ( let + _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Declaration (arg_hd_)) + _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_tl_)) + (T_Declaration_vOut28 _hdIresolveErrors _hdIself) = inv_Declaration_s29 _hdX29 (T_Declaration_vIn28 _hdOopTable _hdOresolveErrors) + (T_Declarations_vOut31 _tlIresolveErrors _tlIself) = inv_Declarations_s32 _tlX32 (T_Declarations_vIn31 _tlOopTable _tlOresolveErrors) + _self = rule104 _hdIself _tlIself + _lhsOself :: Declarations + _lhsOself = rule105 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule106 _tlIresolveErrors + _hdOopTable = rule107 _lhsIopTable + _hdOresolveErrors = rule108 _lhsIresolveErrors + _tlOopTable = rule109 _lhsIopTable + _tlOresolveErrors = rule110 _hdIresolveErrors + __result_ = T_Declarations_vOut31 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule104 #-} + rule104 = \ ((_hdIself) :: Declaration) ((_tlIself) :: Declarations) -> + (:) _hdIself _tlIself + {-# INLINE rule105 #-} + rule105 = \ _self -> + _self + {-# INLINE rule106 #-} + rule106 = \ ((_tlIresolveErrors) :: [ResolveError] ) -> + _tlIresolveErrors + {-# INLINE rule107 #-} + rule107 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule108 #-} + rule108 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule109 #-} + rule109 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule110 #-} + rule110 = \ ((_hdIresolveErrors) :: [ResolveError] ) -> + _hdIresolveErrors +{-# NOINLINE sem_Declarations_Nil #-} +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule111 () + _lhsOself :: Declarations + _lhsOself = rule112 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule113 _lhsIresolveErrors + __result_ = T_Declarations_vOut31 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule111 #-} + rule111 = \ (_ :: ()) -> + [] + {-# INLINE rule112 #-} + rule112 = \ _self -> + _self + {-# INLINE rule113 #-} + rule113 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Export ------------------------------------------------------ +-- wrapper +data Inh_Export = Inh_Export { } +data Syn_Export = Syn_Export { self_Syn_Export :: (Export) } +{-# INLINABLE wrap_Export #-} +wrap_Export :: T_Export -> Inh_Export -> (Syn_Export ) +wrap_Export (T_Export act) (Inh_Export ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Export_vIn34 + (T_Export_vOut34 _lhsOself) <- return (inv_Export_s35 sem arg) + return (Syn_Export _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Export #-} +sem_Export :: Export -> T_Export +sem_Export ( Export_Variable range_ name_ ) = sem_Export_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_TypeOrClass range_ name_ names_ ) = sem_Export_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Export ( Export_TypeOrClassComplete range_ name_ ) = sem_Export_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_Module range_ name_ ) = sem_Export_Module ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Export = T_Export { + attach_T_Export :: Identity (T_Export_s35 ) + } +newtype T_Export_s35 = C_Export_s35 { + inv_Export_s35 :: (T_Export_v34 ) + } +data T_Export_s36 = C_Export_s36 +type T_Export_v34 = (T_Export_vIn34 ) -> (T_Export_vOut34 ) +data T_Export_vIn34 = T_Export_vIn34 +data T_Export_vOut34 = T_Export_vOut34 (Export) +{-# NOINLINE sem_Export_Variable #-} +sem_Export_Variable :: T_Range -> T_Name -> T_Export +sem_Export_Variable arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule114 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule115 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule114 #-} + rule114 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Variable _rangeIself _nameIself + {-# INLINE rule115 #-} + rule115 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClass #-} +sem_Export_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Export +sem_Export_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _self = rule116 _nameIself _namesIself _rangeIself + _lhsOself :: Export + _lhsOself = rule117 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule116 #-} + rule116 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Export_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule117 #-} + rule117 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClassComplete #-} +sem_Export_TypeOrClassComplete :: T_Range -> T_Name -> T_Export +sem_Export_TypeOrClassComplete arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule118 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule119 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule118 #-} + rule118 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule119 #-} + rule119 = \ _self -> + _self +{-# NOINLINE sem_Export_Module #-} +sem_Export_Module :: T_Range -> T_Name -> T_Export +sem_Export_Module arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule120 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule121 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule120 #-} + rule120 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Module _rangeIself _nameIself + {-# INLINE rule121 #-} + rule121 = \ _self -> + _self + +-- Exports ----------------------------------------------------- +-- wrapper +data Inh_Exports = Inh_Exports { } +data Syn_Exports = Syn_Exports { self_Syn_Exports :: (Exports) } +{-# INLINABLE wrap_Exports #-} +wrap_Exports :: T_Exports -> Inh_Exports -> (Syn_Exports ) +wrap_Exports (T_Exports act) (Inh_Exports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Exports_vIn37 + (T_Exports_vOut37 _lhsOself) <- return (inv_Exports_s38 sem arg) + return (Syn_Exports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Exports #-} +sem_Exports :: Exports -> T_Exports +sem_Exports list = Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list) + +-- semantic domain +newtype T_Exports = T_Exports { + attach_T_Exports :: Identity (T_Exports_s38 ) + } +newtype T_Exports_s38 = C_Exports_s38 { + inv_Exports_s38 :: (T_Exports_v37 ) + } +data T_Exports_s39 = C_Exports_s39 +type T_Exports_v37 = (T_Exports_vIn37 ) -> (T_Exports_vOut37 ) +data T_Exports_vIn37 = T_Exports_vIn37 +data T_Exports_vOut37 = T_Exports_vOut37 (Exports) +{-# NOINLINE sem_Exports_Cons #-} +sem_Exports_Cons :: T_Export -> T_Exports -> T_Exports +sem_Exports_Cons arg_hd_ arg_tl_ = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Export (arg_hd_)) + _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_tl_)) + (T_Export_vOut34 _hdIself) = inv_Export_s35 _hdX35 (T_Export_vIn34 ) + (T_Exports_vOut37 _tlIself) = inv_Exports_s38 _tlX38 (T_Exports_vIn37 ) + _self = rule122 _hdIself _tlIself + _lhsOself :: Exports + _lhsOself = rule123 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule122 #-} + rule122 = \ ((_hdIself) :: Export) ((_tlIself) :: Exports) -> + (:) _hdIself _tlIself + {-# INLINE rule123 #-} + rule123 = \ _self -> + _self +{-# NOINLINE sem_Exports_Nil #-} +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _self = rule124 () + _lhsOself :: Exports + _lhsOself = rule125 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule124 #-} + rule124 = \ (_ :: ()) -> + [] + {-# INLINE rule125 #-} + rule125 = \ _self -> + _self + +-- Expression -------------------------------------------------- +-- wrapper +data Inh_Expression = Inh_Expression { opTable_Inh_Expression :: (OperatorTable), resolveErrors_Inh_Expression :: ( [ResolveError] ) } +data Syn_Expression = Syn_Expression { resolveErrors_Syn_Expression :: ( [ResolveError] ), self_Syn_Expression :: (Expression) } +{-# INLINABLE wrap_Expression #-} +wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) +wrap_Expression (T_Expression act) (Inh_Expression _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors + (T_Expression_vOut40 _lhsOresolveErrors _lhsOself) <- return (inv_Expression_s41 sem arg) + return (Syn_Expression _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expression #-} +sem_Expression :: Expression -> T_Expression +sem_Expression ( Expression_Hole range_ id_ ) = sem_Expression_Hole ( sem_Range range_ ) id_ +sem_Expression ( Expression_Feedback range_ feedback_ expression_ ) = sem_Expression_Feedback ( sem_Range range_ ) feedback_ ( sem_Expression expression_ ) +sem_Expression ( Expression_MustUse range_ expression_ ) = sem_Expression_MustUse ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Literal range_ literal_ ) = sem_Expression_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Expression ( Expression_Variable range_ name_ ) = sem_Expression_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Constructor range_ name_ ) = sem_Expression_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Parenthesized range_ expression_ ) = sem_Expression_Parenthesized ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NormalApplication range_ function_ arguments_ ) = sem_Expression_NormalApplication ( sem_Range range_ ) ( sem_Expression function_ ) ( sem_Expressions arguments_ ) +sem_Expression ( Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ ) = sem_Expression_InfixApplication ( sem_Range range_ ) ( sem_MaybeExpression leftExpression_ ) ( sem_Expression operator_ ) ( sem_MaybeExpression rightExpression_ ) +sem_Expression ( Expression_If range_ guardExpression_ thenExpression_ elseExpression_ ) = sem_Expression_If ( sem_Range range_ ) ( sem_Expression guardExpression_ ) ( sem_Expression thenExpression_ ) ( sem_Expression elseExpression_ ) +sem_Expression ( Expression_Lambda range_ patterns_ expression_ ) = sem_Expression_Lambda ( sem_Range range_ ) ( sem_Patterns patterns_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Case range_ expression_ alternatives_ ) = sem_Expression_Case ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Alternatives alternatives_ ) +sem_Expression ( Expression_Let range_ declarations_ expression_ ) = sem_Expression_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Do range_ statements_ ) = sem_Expression_Do ( sem_Range range_ ) ( sem_Statements statements_ ) +sem_Expression ( Expression_List range_ expressions_ ) = sem_Expression_List ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Tuple range_ expressions_ ) = sem_Expression_Tuple ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Comprehension range_ expression_ qualifiers_ ) = sem_Expression_Comprehension ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Qualifiers qualifiers_ ) +sem_Expression ( Expression_Typed range_ expression_ type_ ) = sem_Expression_Typed ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Type type_ ) +sem_Expression ( Expression_RecordConstruction range_ name_ recordExpressionBindings_ ) = sem_Expression_RecordConstruction ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_RecordUpdate range_ expression_ recordExpressionBindings_ ) = sem_Expression_RecordUpdate ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_Enum range_ from_ then_ to_ ) = sem_Expression_Enum ( sem_Range range_ ) ( sem_Expression from_ ) ( sem_MaybeExpression then_ ) ( sem_MaybeExpression to_ ) +sem_Expression ( Expression_Negate range_ expression_ ) = sem_Expression_Negate ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NegateFloat range_ expression_ ) = sem_Expression_NegateFloat ( sem_Range range_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_Expression = T_Expression { + attach_T_Expression :: Identity (T_Expression_s41 ) + } +newtype T_Expression_s41 = C_Expression_s41 { + inv_Expression_s41 :: (T_Expression_v40 ) + } +data T_Expression_s42 = C_Expression_s42 +type T_Expression_v40 = (T_Expression_vIn40 ) -> (T_Expression_vOut40 ) +data T_Expression_vIn40 = T_Expression_vIn40 (OperatorTable) ( [ResolveError] ) +data T_Expression_vOut40 = T_Expression_vOut40 ( [ResolveError] ) (Expression) +{-# NOINLINE sem_Expression_Hole #-} +sem_Expression_Hole :: T_Range -> (Integer) -> T_Expression +sem_Expression_Hole arg_range_ arg_id_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule126 _rangeIself arg_id_ + _lhsOself :: Expression + _lhsOself = rule127 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule128 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule126 #-} + rule126 = \ ((_rangeIself) :: Range) id_ -> + Expression_Hole _rangeIself id_ + {-# INLINE rule127 #-} + rule127 = \ _self -> + _self + {-# INLINE rule128 #-} + rule128 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_Feedback #-} +sem_Expression_Feedback :: T_Range -> (String) -> T_Expression -> T_Expression +sem_Expression_Feedback arg_range_ arg_feedback_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule129 _expressionIself _rangeIself arg_feedback_ + _lhsOself :: Expression + _lhsOself = rule130 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule131 _expressionIresolveErrors + _expressionOopTable = rule132 _lhsIopTable + _expressionOresolveErrors = rule133 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule129 #-} + rule129 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) feedback_ -> + Expression_Feedback _rangeIself feedback_ _expressionIself + {-# INLINE rule130 #-} + rule130 = \ _self -> + _self + {-# INLINE rule131 #-} + rule131 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule132 #-} + rule132 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule133 #-} + rule133 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_MustUse #-} +sem_Expression_MustUse :: T_Range -> T_Expression -> T_Expression +sem_Expression_MustUse arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule134 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule135 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule136 _expressionIresolveErrors + _expressionOopTable = rule137 _lhsIopTable + _expressionOresolveErrors = rule138 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule134 #-} + rule134 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_MustUse _rangeIself _expressionIself + {-# INLINE rule135 #-} + rule135 = \ _self -> + _self + {-# INLINE rule136 #-} + rule136 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule137 #-} + rule137 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule138 #-} + rule138 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_Literal #-} +sem_Expression_Literal :: T_Range -> T_Literal -> T_Expression +sem_Expression_Literal arg_range_ arg_literal_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule139 _literalIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule140 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule141 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule139 #-} + rule139 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Expression_Literal _rangeIself _literalIself + {-# INLINE rule140 #-} + rule140 = \ _self -> + _self + {-# INLINE rule141 #-} + rule141 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_Variable #-} +sem_Expression_Variable :: T_Range -> T_Name -> T_Expression +sem_Expression_Variable arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule142 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule143 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule144 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule142 #-} + rule142 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Variable _rangeIself _nameIself + {-# INLINE rule143 #-} + rule143 = \ _self -> + _self + {-# INLINE rule144 #-} + rule144 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_Constructor #-} +sem_Expression_Constructor :: T_Range -> T_Name -> T_Expression +sem_Expression_Constructor arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule145 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule146 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule147 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule145 #-} + rule145 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Constructor _rangeIself _nameIself + {-# INLINE rule146 #-} + rule146 = \ _self -> + _self + {-# INLINE rule147 #-} + rule147 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_Parenthesized #-} +sem_Expression_Parenthesized :: T_Range -> T_Expression -> T_Expression +sem_Expression_Parenthesized arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule148 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule149 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule150 _expressionIresolveErrors + _expressionOopTable = rule151 _lhsIopTable + _expressionOresolveErrors = rule152 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule148 #-} + rule148 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Parenthesized _rangeIself _expressionIself + {-# INLINE rule149 #-} + rule149 = \ _self -> + _self + {-# INLINE rule150 #-} + rule150 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule151 #-} + rule151 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule152 #-} + rule152 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_NormalApplication #-} +sem_Expression_NormalApplication :: T_Range -> T_Expression -> T_Expressions -> T_Expression +sem_Expression_NormalApplication arg_range_ arg_function_ arg_arguments_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_function_)) + _argumentsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _functionIresolveErrors _functionIself) = inv_Expression_s41 _functionX41 (T_Expression_vIn40 _functionOopTable _functionOresolveErrors) + (T_Expressions_vOut43 _argumentsIresolveErrors _argumentsIself) = inv_Expressions_s44 _argumentsX44 (T_Expressions_vIn43 _argumentsOopTable _argumentsOresolveErrors) + _self = rule153 _argumentsIself _functionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule154 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule155 _argumentsIresolveErrors + _functionOopTable = rule156 _lhsIopTable + _functionOresolveErrors = rule157 _lhsIresolveErrors + _argumentsOopTable = rule158 _lhsIopTable + _argumentsOresolveErrors = rule159 _functionIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule153 #-} + rule153 = \ ((_argumentsIself) :: Expressions) ((_functionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NormalApplication _rangeIself _functionIself _argumentsIself + {-# INLINE rule154 #-} + rule154 = \ _self -> + _self + {-# INLINE rule155 #-} + rule155 = \ ((_argumentsIresolveErrors) :: [ResolveError] ) -> + _argumentsIresolveErrors + {-# INLINE rule156 #-} + rule156 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule157 #-} + rule157 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule158 #-} + rule158 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule159 #-} + rule159 = \ ((_functionIresolveErrors) :: [ResolveError] ) -> + _functionIresolveErrors +{-# NOINLINE sem_Expression_InfixApplication #-} +sem_Expression_InfixApplication :: T_Range -> T_MaybeExpression -> T_Expression -> T_MaybeExpression -> T_Expression +sem_Expression_InfixApplication arg_range_ arg_leftExpression_ arg_operator_ arg_rightExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_leftExpression_)) + _operatorX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_operator_)) + _rightExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_rightExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeExpression_vOut94 _leftExpressionIresolveErrors _leftExpressionIself) = inv_MaybeExpression_s95 _leftExpressionX95 (T_MaybeExpression_vIn94 _leftExpressionOopTable _leftExpressionOresolveErrors) + (T_Expression_vOut40 _operatorIresolveErrors _operatorIself) = inv_Expression_s41 _operatorX41 (T_Expression_vIn40 _operatorOopTable _operatorOresolveErrors) + (T_MaybeExpression_vOut94 _rightExpressionIresolveErrors _rightExpressionIself) = inv_MaybeExpression_s95 _rightExpressionX95 (T_MaybeExpression_vIn94 _rightExpressionOopTable _rightExpressionOresolveErrors) + _self = rule160 _leftExpressionIself _operatorIself _rangeIself _rightExpressionIself + _lhsOself :: Expression + _lhsOself = rule161 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule162 _rightExpressionIresolveErrors + _leftExpressionOopTable = rule163 _lhsIopTable + _leftExpressionOresolveErrors = rule164 _lhsIresolveErrors + _operatorOopTable = rule165 _lhsIopTable + _operatorOresolveErrors = rule166 _leftExpressionIresolveErrors + _rightExpressionOopTable = rule167 _lhsIopTable + _rightExpressionOresolveErrors = rule168 _operatorIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule160 #-} + rule160 = \ ((_leftExpressionIself) :: MaybeExpression) ((_operatorIself) :: Expression) ((_rangeIself) :: Range) ((_rightExpressionIself) :: MaybeExpression) -> + Expression_InfixApplication _rangeIself _leftExpressionIself _operatorIself _rightExpressionIself + {-# INLINE rule161 #-} + rule161 = \ _self -> + _self + {-# INLINE rule162 #-} + rule162 = \ ((_rightExpressionIresolveErrors) :: [ResolveError] ) -> + _rightExpressionIresolveErrors + {-# INLINE rule163 #-} + rule163 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule164 #-} + rule164 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule165 #-} + rule165 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule166 #-} + rule166 = \ ((_leftExpressionIresolveErrors) :: [ResolveError] ) -> + _leftExpressionIresolveErrors + {-# INLINE rule167 #-} + rule167 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule168 #-} + rule168 = \ ((_operatorIresolveErrors) :: [ResolveError] ) -> + _operatorIresolveErrors +{-# NOINLINE sem_Expression_If #-} +sem_Expression_If :: T_Range -> T_Expression -> T_Expression -> T_Expression -> T_Expression +sem_Expression_If arg_range_ arg_guardExpression_ arg_thenExpression_ arg_elseExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guardExpression_)) + _thenExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_thenExpression_)) + _elseExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_elseExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardExpressionIresolveErrors _guardExpressionIself) = inv_Expression_s41 _guardExpressionX41 (T_Expression_vIn40 _guardExpressionOopTable _guardExpressionOresolveErrors) + (T_Expression_vOut40 _thenExpressionIresolveErrors _thenExpressionIself) = inv_Expression_s41 _thenExpressionX41 (T_Expression_vIn40 _thenExpressionOopTable _thenExpressionOresolveErrors) + (T_Expression_vOut40 _elseExpressionIresolveErrors _elseExpressionIself) = inv_Expression_s41 _elseExpressionX41 (T_Expression_vIn40 _elseExpressionOopTable _elseExpressionOresolveErrors) + _self = rule169 _elseExpressionIself _guardExpressionIself _rangeIself _thenExpressionIself + _lhsOself :: Expression + _lhsOself = rule170 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule171 _elseExpressionIresolveErrors + _guardExpressionOopTable = rule172 _lhsIopTable + _guardExpressionOresolveErrors = rule173 _lhsIresolveErrors + _thenExpressionOopTable = rule174 _lhsIopTable + _thenExpressionOresolveErrors = rule175 _guardExpressionIresolveErrors + _elseExpressionOopTable = rule176 _lhsIopTable + _elseExpressionOresolveErrors = rule177 _thenExpressionIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule169 #-} + rule169 = \ ((_elseExpressionIself) :: Expression) ((_guardExpressionIself) :: Expression) ((_rangeIself) :: Range) ((_thenExpressionIself) :: Expression) -> + Expression_If _rangeIself _guardExpressionIself _thenExpressionIself _elseExpressionIself + {-# INLINE rule170 #-} + rule170 = \ _self -> + _self + {-# INLINE rule171 #-} + rule171 = \ ((_elseExpressionIresolveErrors) :: [ResolveError] ) -> + _elseExpressionIresolveErrors + {-# INLINE rule172 #-} + rule172 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule173 #-} + rule173 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule174 #-} + rule174 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule175 #-} + rule175 = \ ((_guardExpressionIresolveErrors) :: [ResolveError] ) -> + _guardExpressionIresolveErrors + {-# INLINE rule176 #-} + rule176 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule177 #-} + rule177 = \ ((_thenExpressionIresolveErrors) :: [ResolveError] ) -> + _thenExpressionIresolveErrors +{-# NOINLINE sem_Expression_Lambda #-} +sem_Expression_Lambda :: T_Range -> T_Patterns -> T_Expression -> T_Expression +sem_Expression_Lambda arg_range_ arg_patterns_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIresolveErrors _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOopTable _patternsOresolveErrors) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule178 _expressionIself _patternsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule179 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule180 _expressionIresolveErrors + _patternsOopTable = rule181 _lhsIopTable + _patternsOresolveErrors = rule182 _lhsIresolveErrors + _expressionOopTable = rule183 _lhsIopTable + _expressionOresolveErrors = rule184 _patternsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule178 #-} + rule178 = \ ((_expressionIself) :: Expression) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Expression_Lambda _rangeIself _patternsIself _expressionIself + {-# INLINE rule179 #-} + rule179 = \ _self -> + _self + {-# INLINE rule180 #-} + rule180 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule181 #-} + rule181 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule182 #-} + rule182 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule183 #-} + rule183 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule184 #-} + rule184 = \ ((_patternsIresolveErrors) :: [ResolveError] ) -> + _patternsIresolveErrors +{-# NOINLINE sem_Expression_Case #-} +sem_Expression_Case :: T_Range -> T_Expression -> T_Alternatives -> T_Expression +sem_Expression_Case arg_range_ arg_expression_ arg_alternatives_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _alternativesX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_alternatives_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + (T_Alternatives_vOut4 _alternativesIresolveErrors _alternativesIself) = inv_Alternatives_s5 _alternativesX5 (T_Alternatives_vIn4 _alternativesOopTable _alternativesOresolveErrors) + _self = rule185 _alternativesIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule186 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule187 _alternativesIresolveErrors + _expressionOopTable = rule188 _lhsIopTable + _expressionOresolveErrors = rule189 _lhsIresolveErrors + _alternativesOopTable = rule190 _lhsIopTable + _alternativesOresolveErrors = rule191 _expressionIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule185 #-} + rule185 = \ ((_alternativesIself) :: Alternatives) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Case _rangeIself _expressionIself _alternativesIself + {-# INLINE rule186 #-} + rule186 = \ _self -> + _self + {-# INLINE rule187 #-} + rule187 = \ ((_alternativesIresolveErrors) :: [ResolveError] ) -> + _alternativesIresolveErrors + {-# INLINE rule188 #-} + rule188 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule189 #-} + rule189 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule190 #-} + rule190 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule191 #-} + rule191 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors +{-# NOINLINE sem_Expression_Let #-} +sem_Expression_Let :: T_Range -> T_Declarations -> T_Expression -> T_Expression +sem_Expression_Let arg_range_ arg_declarations_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIresolveErrors _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOopTable _declarationsOresolveErrors) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule192 _declarationsIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule193 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule194 _expressionIresolveErrors + _declarationsOopTable = rule195 _lhsIopTable + _declarationsOresolveErrors = rule196 _lhsIresolveErrors + _expressionOopTable = rule197 _lhsIopTable + _expressionOresolveErrors = rule198 _declarationsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule192 #-} + rule192 = \ ((_declarationsIself) :: Declarations) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Let _rangeIself _declarationsIself _expressionIself + {-# INLINE rule193 #-} + rule193 = \ _self -> + _self + {-# INLINE rule194 #-} + rule194 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule195 #-} + rule195 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule196 #-} + rule196 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule197 #-} + rule197 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule198 #-} + rule198 = \ ((_declarationsIresolveErrors) :: [ResolveError] ) -> + _declarationsIresolveErrors +{-# NOINLINE sem_Expression_Do #-} +sem_Expression_Do :: T_Range -> T_Statements -> T_Expression +sem_Expression_Do arg_range_ arg_statements_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _statementsX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_statements_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Statements_vOut157 _statementsIresolveErrors _statementsIself) = inv_Statements_s158 _statementsX158 (T_Statements_vIn157 _statementsOopTable _statementsOresolveErrors) + _self = rule199 _rangeIself _statementsIself + _lhsOself :: Expression + _lhsOself = rule200 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule201 _statementsIresolveErrors + _statementsOopTable = rule202 _lhsIopTable + _statementsOresolveErrors = rule203 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule199 #-} + rule199 = \ ((_rangeIself) :: Range) ((_statementsIself) :: Statements) -> + Expression_Do _rangeIself _statementsIself + {-# INLINE rule200 #-} + rule200 = \ _self -> + _self + {-# INLINE rule201 #-} + rule201 = \ ((_statementsIresolveErrors) :: [ResolveError] ) -> + _statementsIresolveErrors + {-# INLINE rule202 #-} + rule202 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule203 #-} + rule203 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_List #-} +sem_Expression_List :: T_Range -> T_Expressions -> T_Expression +sem_Expression_List arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIresolveErrors _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 _expressionsOopTable _expressionsOresolveErrors) + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule204 _errs _expressionsIresolveErrors + (_self,_errs) = rule205 _expressionsIself _lhsIopTable _rangeIself + _lhsOself :: Expression + _lhsOself = rule206 _self + _expressionsOopTable = rule207 _lhsIopTable + _expressionsOresolveErrors = rule208 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule204 #-} + rule204 = \ _errs ((_expressionsIresolveErrors) :: [ResolveError] ) -> + _errs ++ _expressionsIresolveErrors + {-# INLINE rule205 #-} + rule205 = \ ((_expressionsIself) :: Expressions) ((_lhsIopTable) :: OperatorTable) ((_rangeIself) :: Range) -> + case _rangeIself of + Range_Range Position_Unknown Position_Unknown -> + resolveExpression _lhsIopTable _expressionsIself + _ -> (Expression_List _rangeIself _expressionsIself, []) + {-# INLINE rule206 #-} + rule206 = \ _self -> + _self + {-# INLINE rule207 #-} + rule207 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule208 #-} + rule208 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_Tuple #-} +sem_Expression_Tuple :: T_Range -> T_Expressions -> T_Expression +sem_Expression_Tuple arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIresolveErrors _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 _expressionsOopTable _expressionsOresolveErrors) + _self = rule209 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule210 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule211 _expressionsIresolveErrors + _expressionsOopTable = rule212 _lhsIopTable + _expressionsOresolveErrors = rule213 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule209 #-} + rule209 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_Tuple _rangeIself _expressionsIself + {-# INLINE rule210 #-} + rule210 = \ _self -> + _self + {-# INLINE rule211 #-} + rule211 = \ ((_expressionsIresolveErrors) :: [ResolveError] ) -> + _expressionsIresolveErrors + {-# INLINE rule212 #-} + rule212 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule213 #-} + rule213 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_Comprehension #-} +sem_Expression_Comprehension :: T_Range -> T_Expression -> T_Qualifiers -> T_Expression +sem_Expression_Comprehension arg_range_ arg_expression_ arg_qualifiers_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _qualifiersX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_qualifiers_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + (T_Qualifiers_vOut130 _qualifiersIresolveErrors _qualifiersIself) = inv_Qualifiers_s131 _qualifiersX131 (T_Qualifiers_vIn130 _qualifiersOopTable _qualifiersOresolveErrors) + _self = rule214 _expressionIself _qualifiersIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule215 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule216 _qualifiersIresolveErrors + _expressionOopTable = rule217 _lhsIopTable + _expressionOresolveErrors = rule218 _lhsIresolveErrors + _qualifiersOopTable = rule219 _lhsIopTable + _qualifiersOresolveErrors = rule220 _expressionIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule214 #-} + rule214 = \ ((_expressionIself) :: Expression) ((_qualifiersIself) :: Qualifiers) ((_rangeIself) :: Range) -> + Expression_Comprehension _rangeIself _expressionIself _qualifiersIself + {-# INLINE rule215 #-} + rule215 = \ _self -> + _self + {-# INLINE rule216 #-} + rule216 = \ ((_qualifiersIresolveErrors) :: [ResolveError] ) -> + _qualifiersIresolveErrors + {-# INLINE rule217 #-} + rule217 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule218 #-} + rule218 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule219 #-} + rule219 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule220 #-} + rule220 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors +{-# NOINLINE sem_Expression_Typed #-} +sem_Expression_Typed :: T_Range -> T_Expression -> T_Type -> T_Expression +sem_Expression_Typed arg_range_ arg_expression_ arg_type_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule221 _expressionIself _rangeIself _typeIself + _lhsOself :: Expression + _lhsOself = rule222 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule223 _expressionIresolveErrors + _expressionOopTable = rule224 _lhsIopTable + _expressionOresolveErrors = rule225 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule221 #-} + rule221 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Expression_Typed _rangeIself _expressionIself _typeIself + {-# INLINE rule222 #-} + rule222 = \ _self -> + _self + {-# INLINE rule223 #-} + rule223 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule224 #-} + rule224 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule225 #-} + rule225 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_RecordConstruction #-} +sem_Expression_RecordConstruction :: T_Range -> T_Name -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordConstruction arg_range_ arg_name_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIresolveErrors _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 _recordExpressionBindingsOopTable _recordExpressionBindingsOresolveErrors) + _self = rule226 _nameIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule227 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule228 _recordExpressionBindingsIresolveErrors + _recordExpressionBindingsOopTable = rule229 _lhsIopTable + _recordExpressionBindingsOresolveErrors = rule230 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule226 #-} + rule226 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordConstruction _rangeIself _nameIself _recordExpressionBindingsIself + {-# INLINE rule227 #-} + rule227 = \ _self -> + _self + {-# INLINE rule228 #-} + rule228 = \ ((_recordExpressionBindingsIresolveErrors) :: [ResolveError] ) -> + _recordExpressionBindingsIresolveErrors + {-# INLINE rule229 #-} + rule229 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule230 #-} + rule230 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_RecordUpdate #-} +sem_Expression_RecordUpdate :: T_Range -> T_Expression -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordUpdate arg_range_ arg_expression_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIresolveErrors _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 _recordExpressionBindingsOopTable _recordExpressionBindingsOresolveErrors) + _self = rule231 _expressionIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule232 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule233 _recordExpressionBindingsIresolveErrors + _expressionOopTable = rule234 _lhsIopTable + _expressionOresolveErrors = rule235 _lhsIresolveErrors + _recordExpressionBindingsOopTable = rule236 _lhsIopTable + _recordExpressionBindingsOresolveErrors = rule237 _expressionIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule231 #-} + rule231 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordUpdate _rangeIself _expressionIself _recordExpressionBindingsIself + {-# INLINE rule232 #-} + rule232 = \ _self -> + _self + {-# INLINE rule233 #-} + rule233 = \ ((_recordExpressionBindingsIresolveErrors) :: [ResolveError] ) -> + _recordExpressionBindingsIresolveErrors + {-# INLINE rule234 #-} + rule234 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule235 #-} + rule235 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule236 #-} + rule236 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule237 #-} + rule237 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors +{-# NOINLINE sem_Expression_Enum #-} +sem_Expression_Enum :: T_Range -> T_Expression -> T_MaybeExpression -> T_MaybeExpression -> T_Expression +sem_Expression_Enum arg_range_ arg_from_ arg_then_ arg_to_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fromX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_from_)) + _thenX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_then_)) + _toX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_to_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _fromIresolveErrors _fromIself) = inv_Expression_s41 _fromX41 (T_Expression_vIn40 _fromOopTable _fromOresolveErrors) + (T_MaybeExpression_vOut94 _thenIresolveErrors _thenIself) = inv_MaybeExpression_s95 _thenX95 (T_MaybeExpression_vIn94 _thenOopTable _thenOresolveErrors) + (T_MaybeExpression_vOut94 _toIresolveErrors _toIself) = inv_MaybeExpression_s95 _toX95 (T_MaybeExpression_vIn94 _toOopTable _toOresolveErrors) + _self = rule238 _fromIself _rangeIself _thenIself _toIself + _lhsOself :: Expression + _lhsOself = rule239 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule240 _toIresolveErrors + _fromOopTable = rule241 _lhsIopTable + _fromOresolveErrors = rule242 _lhsIresolveErrors + _thenOopTable = rule243 _lhsIopTable + _thenOresolveErrors = rule244 _fromIresolveErrors + _toOopTable = rule245 _lhsIopTable + _toOresolveErrors = rule246 _thenIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule238 #-} + rule238 = \ ((_fromIself) :: Expression) ((_rangeIself) :: Range) ((_thenIself) :: MaybeExpression) ((_toIself) :: MaybeExpression) -> + Expression_Enum _rangeIself _fromIself _thenIself _toIself + {-# INLINE rule239 #-} + rule239 = \ _self -> + _self + {-# INLINE rule240 #-} + rule240 = \ ((_toIresolveErrors) :: [ResolveError] ) -> + _toIresolveErrors + {-# INLINE rule241 #-} + rule241 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule242 #-} + rule242 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule243 #-} + rule243 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule244 #-} + rule244 = \ ((_fromIresolveErrors) :: [ResolveError] ) -> + _fromIresolveErrors + {-# INLINE rule245 #-} + rule245 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule246 #-} + rule246 = \ ((_thenIresolveErrors) :: [ResolveError] ) -> + _thenIresolveErrors +{-# NOINLINE sem_Expression_Negate #-} +sem_Expression_Negate :: T_Range -> T_Expression -> T_Expression +sem_Expression_Negate arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule247 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule248 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule249 _expressionIresolveErrors + _expressionOopTable = rule250 _lhsIopTable + _expressionOresolveErrors = rule251 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule247 #-} + rule247 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Negate _rangeIself _expressionIself + {-# INLINE rule248 #-} + rule248 = \ _self -> + _self + {-# INLINE rule249 #-} + rule249 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule250 #-} + rule250 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule251 #-} + rule251 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Expression_NegateFloat #-} +sem_Expression_NegateFloat :: T_Range -> T_Expression -> T_Expression +sem_Expression_NegateFloat arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule252 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule253 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule254 _expressionIresolveErrors + _expressionOopTable = rule255 _lhsIopTable + _expressionOresolveErrors = rule256 _lhsIresolveErrors + __result_ = T_Expression_vOut40 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule252 #-} + rule252 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NegateFloat _rangeIself _expressionIself + {-# INLINE rule253 #-} + rule253 = \ _self -> + _self + {-# INLINE rule254 #-} + rule254 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule255 #-} + rule255 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule256 #-} + rule256 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Expressions ------------------------------------------------- +-- wrapper +data Inh_Expressions = Inh_Expressions { opTable_Inh_Expressions :: (OperatorTable), resolveErrors_Inh_Expressions :: ( [ResolveError] ) } +data Syn_Expressions = Syn_Expressions { resolveErrors_Syn_Expressions :: ( [ResolveError] ), self_Syn_Expressions :: (Expressions) } +{-# INLINABLE wrap_Expressions #-} +wrap_Expressions :: T_Expressions -> Inh_Expressions -> (Syn_Expressions ) +wrap_Expressions (T_Expressions act) (Inh_Expressions _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expressions_vIn43 _lhsIopTable _lhsIresolveErrors + (T_Expressions_vOut43 _lhsOresolveErrors _lhsOself) <- return (inv_Expressions_s44 sem arg) + return (Syn_Expressions _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expressions #-} +sem_Expressions :: Expressions -> T_Expressions +sem_Expressions list = Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list) + +-- semantic domain +newtype T_Expressions = T_Expressions { + attach_T_Expressions :: Identity (T_Expressions_s44 ) + } +newtype T_Expressions_s44 = C_Expressions_s44 { + inv_Expressions_s44 :: (T_Expressions_v43 ) + } +data T_Expressions_s45 = C_Expressions_s45 +type T_Expressions_v43 = (T_Expressions_vIn43 ) -> (T_Expressions_vOut43 ) +data T_Expressions_vIn43 = T_Expressions_vIn43 (OperatorTable) ( [ResolveError] ) +data T_Expressions_vOut43 = T_Expressions_vOut43 ( [ResolveError] ) (Expressions) +{-# NOINLINE sem_Expressions_Cons #-} +sem_Expressions_Cons :: T_Expression -> T_Expressions -> T_Expressions +sem_Expressions_Cons arg_hd_ arg_tl_ = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 _lhsIopTable _lhsIresolveErrors) -> ( let + _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_hd_)) + _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_tl_)) + (T_Expression_vOut40 _hdIresolveErrors _hdIself) = inv_Expression_s41 _hdX41 (T_Expression_vIn40 _hdOopTable _hdOresolveErrors) + (T_Expressions_vOut43 _tlIresolveErrors _tlIself) = inv_Expressions_s44 _tlX44 (T_Expressions_vIn43 _tlOopTable _tlOresolveErrors) + _self = rule257 _hdIself _tlIself + _lhsOself :: Expressions + _lhsOself = rule258 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule259 _tlIresolveErrors + _hdOopTable = rule260 _lhsIopTable + _hdOresolveErrors = rule261 _lhsIresolveErrors + _tlOopTable = rule262 _lhsIopTable + _tlOresolveErrors = rule263 _hdIresolveErrors + __result_ = T_Expressions_vOut43 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule257 #-} + rule257 = \ ((_hdIself) :: Expression) ((_tlIself) :: Expressions) -> + (:) _hdIself _tlIself + {-# INLINE rule258 #-} + rule258 = \ _self -> + _self + {-# INLINE rule259 #-} + rule259 = \ ((_tlIresolveErrors) :: [ResolveError] ) -> + _tlIresolveErrors + {-# INLINE rule260 #-} + rule260 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule261 #-} + rule261 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule262 #-} + rule262 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule263 #-} + rule263 = \ ((_hdIresolveErrors) :: [ResolveError] ) -> + _hdIresolveErrors +{-# NOINLINE sem_Expressions_Nil #-} +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule264 () + _lhsOself :: Expressions + _lhsOself = rule265 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule266 _lhsIresolveErrors + __result_ = T_Expressions_vOut43 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule264 #-} + rule264 = \ (_ :: ()) -> + [] + {-# INLINE rule265 #-} + rule265 = \ _self -> + _self + {-# INLINE rule266 #-} + rule266 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- FieldDeclaration -------------------------------------------- +-- wrapper +data Inh_FieldDeclaration = Inh_FieldDeclaration { } +data Syn_FieldDeclaration = Syn_FieldDeclaration { self_Syn_FieldDeclaration :: (FieldDeclaration) } +{-# INLINABLE wrap_FieldDeclaration #-} +wrap_FieldDeclaration :: T_FieldDeclaration -> Inh_FieldDeclaration -> (Syn_FieldDeclaration ) +wrap_FieldDeclaration (T_FieldDeclaration act) (Inh_FieldDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclaration_vIn46 + (T_FieldDeclaration_vOut46 _lhsOself) <- return (inv_FieldDeclaration_s47 sem arg) + return (Syn_FieldDeclaration _lhsOself) + ) + +-- cata +{-# INLINE sem_FieldDeclaration #-} +sem_FieldDeclaration :: FieldDeclaration -> T_FieldDeclaration +sem_FieldDeclaration ( FieldDeclaration_FieldDeclaration range_ names_ type_ ) = sem_FieldDeclaration_FieldDeclaration ( sem_Range range_ ) ( sem_Names names_ ) ( sem_AnnotatedType type_ ) + +-- semantic domain +newtype T_FieldDeclaration = T_FieldDeclaration { + attach_T_FieldDeclaration :: Identity (T_FieldDeclaration_s47 ) + } +newtype T_FieldDeclaration_s47 = C_FieldDeclaration_s47 { + inv_FieldDeclaration_s47 :: (T_FieldDeclaration_v46 ) + } +data T_FieldDeclaration_s48 = C_FieldDeclaration_s48 +type T_FieldDeclaration_v46 = (T_FieldDeclaration_vIn46 ) -> (T_FieldDeclaration_vOut46 ) +data T_FieldDeclaration_vIn46 = T_FieldDeclaration_vIn46 +data T_FieldDeclaration_vOut46 = T_FieldDeclaration_vOut46 (FieldDeclaration) +{-# NOINLINE sem_FieldDeclaration_FieldDeclaration #-} +sem_FieldDeclaration_FieldDeclaration :: T_Range -> T_Names -> T_AnnotatedType -> T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration arg_range_ arg_names_ arg_type_ = T_FieldDeclaration (return st47) where + {-# NOINLINE st47 #-} + st47 = let + v46 :: T_FieldDeclaration_v46 + v46 = \ (T_FieldDeclaration_vIn46 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_AnnotatedType_vOut7 _typeIself) = inv_AnnotatedType_s8 _typeX8 (T_AnnotatedType_vIn7 ) + _self = rule267 _namesIself _rangeIself _typeIself + _lhsOself :: FieldDeclaration + _lhsOself = rule268 _self + __result_ = T_FieldDeclaration_vOut46 _lhsOself + in __result_ ) + in C_FieldDeclaration_s47 v46 + {-# INLINE rule267 #-} + rule267 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: AnnotatedType) -> + FieldDeclaration_FieldDeclaration _rangeIself _namesIself _typeIself + {-# INLINE rule268 #-} + rule268 = \ _self -> + _self + +-- FieldDeclarations ------------------------------------------- +-- wrapper +data Inh_FieldDeclarations = Inh_FieldDeclarations { } +data Syn_FieldDeclarations = Syn_FieldDeclarations { self_Syn_FieldDeclarations :: (FieldDeclarations) } +{-# INLINABLE wrap_FieldDeclarations #-} +wrap_FieldDeclarations :: T_FieldDeclarations -> Inh_FieldDeclarations -> (Syn_FieldDeclarations ) +wrap_FieldDeclarations (T_FieldDeclarations act) (Inh_FieldDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclarations_vIn49 + (T_FieldDeclarations_vOut49 _lhsOself) <- return (inv_FieldDeclarations_s50 sem arg) + return (Syn_FieldDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FieldDeclarations #-} +sem_FieldDeclarations :: FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations list = Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list) + +-- semantic domain +newtype T_FieldDeclarations = T_FieldDeclarations { + attach_T_FieldDeclarations :: Identity (T_FieldDeclarations_s50 ) + } +newtype T_FieldDeclarations_s50 = C_FieldDeclarations_s50 { + inv_FieldDeclarations_s50 :: (T_FieldDeclarations_v49 ) + } +data T_FieldDeclarations_s51 = C_FieldDeclarations_s51 +type T_FieldDeclarations_v49 = (T_FieldDeclarations_vIn49 ) -> (T_FieldDeclarations_vOut49 ) +data T_FieldDeclarations_vIn49 = T_FieldDeclarations_vIn49 +data T_FieldDeclarations_vOut49 = T_FieldDeclarations_vOut49 (FieldDeclarations) +{-# NOINLINE sem_FieldDeclarations_Cons #-} +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> T_FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations_Cons arg_hd_ arg_tl_ = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _hdX47 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclaration (arg_hd_)) + _tlX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_tl_)) + (T_FieldDeclaration_vOut46 _hdIself) = inv_FieldDeclaration_s47 _hdX47 (T_FieldDeclaration_vIn46 ) + (T_FieldDeclarations_vOut49 _tlIself) = inv_FieldDeclarations_s50 _tlX50 (T_FieldDeclarations_vIn49 ) + _self = rule269 _hdIself _tlIself + _lhsOself :: FieldDeclarations + _lhsOself = rule270 _self + __result_ = T_FieldDeclarations_vOut49 _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule269 #-} + rule269 = \ ((_hdIself) :: FieldDeclaration) ((_tlIself) :: FieldDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule270 #-} + rule270 = \ _self -> + _self +{-# NOINLINE sem_FieldDeclarations_Nil #-} +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _self = rule271 () + _lhsOself :: FieldDeclarations + _lhsOself = rule272 _self + __result_ = T_FieldDeclarations_vOut49 _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule271 #-} + rule271 = \ (_ :: ()) -> + [] + {-# INLINE rule272 #-} + rule272 = \ _self -> + _self + +-- Fixity ------------------------------------------------------ +-- wrapper +data Inh_Fixity = Inh_Fixity { } +data Syn_Fixity = Syn_Fixity { self_Syn_Fixity :: (Fixity) } +{-# INLINABLE wrap_Fixity #-} +wrap_Fixity :: T_Fixity -> Inh_Fixity -> (Syn_Fixity ) +wrap_Fixity (T_Fixity act) (Inh_Fixity ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Fixity_vIn52 + (T_Fixity_vOut52 _lhsOself) <- return (inv_Fixity_s53 sem arg) + return (Syn_Fixity _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Fixity #-} +sem_Fixity :: Fixity -> T_Fixity +sem_Fixity ( Fixity_Infixl range_ ) = sem_Fixity_Infixl ( sem_Range range_ ) +sem_Fixity ( Fixity_Infixr range_ ) = sem_Fixity_Infixr ( sem_Range range_ ) +sem_Fixity ( Fixity_Infix range_ ) = sem_Fixity_Infix ( sem_Range range_ ) + +-- semantic domain +newtype T_Fixity = T_Fixity { + attach_T_Fixity :: Identity (T_Fixity_s53 ) + } +newtype T_Fixity_s53 = C_Fixity_s53 { + inv_Fixity_s53 :: (T_Fixity_v52 ) + } +data T_Fixity_s54 = C_Fixity_s54 +type T_Fixity_v52 = (T_Fixity_vIn52 ) -> (T_Fixity_vOut52 ) +data T_Fixity_vIn52 = T_Fixity_vIn52 +data T_Fixity_vOut52 = T_Fixity_vOut52 (Fixity) +{-# NOINLINE sem_Fixity_Infixl #-} +sem_Fixity_Infixl :: T_Range -> T_Fixity +sem_Fixity_Infixl arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule273 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule274 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule273 #-} + rule273 = \ ((_rangeIself) :: Range) -> + Fixity_Infixl _rangeIself + {-# INLINE rule274 #-} + rule274 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infixr #-} +sem_Fixity_Infixr :: T_Range -> T_Fixity +sem_Fixity_Infixr arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule275 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule276 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule275 #-} + rule275 = \ ((_rangeIself) :: Range) -> + Fixity_Infixr _rangeIself + {-# INLINE rule276 #-} + rule276 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infix #-} +sem_Fixity_Infix :: T_Range -> T_Fixity +sem_Fixity_Infix arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule277 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule278 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule277 #-} + rule277 = \ ((_rangeIself) :: Range) -> + Fixity_Infix _rangeIself + {-# INLINE rule278 #-} + rule278 = \ _self -> + _self + +-- FunctionBinding --------------------------------------------- +-- wrapper +data Inh_FunctionBinding = Inh_FunctionBinding { opTable_Inh_FunctionBinding :: (OperatorTable), resolveErrors_Inh_FunctionBinding :: ( [ResolveError] ) } +data Syn_FunctionBinding = Syn_FunctionBinding { resolveErrors_Syn_FunctionBinding :: ( [ResolveError] ), self_Syn_FunctionBinding :: (FunctionBinding) } +{-# INLINABLE wrap_FunctionBinding #-} +wrap_FunctionBinding :: T_FunctionBinding -> Inh_FunctionBinding -> (Syn_FunctionBinding ) +wrap_FunctionBinding (T_FunctionBinding act) (Inh_FunctionBinding _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBinding_vIn55 _lhsIopTable _lhsIresolveErrors + (T_FunctionBinding_vOut55 _lhsOresolveErrors _lhsOself) <- return (inv_FunctionBinding_s56 sem arg) + return (Syn_FunctionBinding _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBinding #-} +sem_FunctionBinding :: FunctionBinding -> T_FunctionBinding +sem_FunctionBinding ( FunctionBinding_Hole range_ id_ ) = sem_FunctionBinding_Hole ( sem_Range range_ ) id_ +sem_FunctionBinding ( FunctionBinding_Feedback range_ feedback_ functionBinding_ ) = sem_FunctionBinding_Feedback ( sem_Range range_ ) feedback_ ( sem_FunctionBinding functionBinding_ ) +sem_FunctionBinding ( FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ ) = sem_FunctionBinding_FunctionBinding ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_RightHandSide righthandside_ ) + +-- semantic domain +newtype T_FunctionBinding = T_FunctionBinding { + attach_T_FunctionBinding :: Identity (T_FunctionBinding_s56 ) + } +newtype T_FunctionBinding_s56 = C_FunctionBinding_s56 { + inv_FunctionBinding_s56 :: (T_FunctionBinding_v55 ) + } +data T_FunctionBinding_s57 = C_FunctionBinding_s57 +type T_FunctionBinding_v55 = (T_FunctionBinding_vIn55 ) -> (T_FunctionBinding_vOut55 ) +data T_FunctionBinding_vIn55 = T_FunctionBinding_vIn55 (OperatorTable) ( [ResolveError] ) +data T_FunctionBinding_vOut55 = T_FunctionBinding_vOut55 ( [ResolveError] ) (FunctionBinding) +{-# NOINLINE sem_FunctionBinding_Hole #-} +sem_FunctionBinding_Hole :: T_Range -> (Integer) -> T_FunctionBinding +sem_FunctionBinding_Hole arg_range_ arg_id_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule279 _rangeIself arg_id_ + _lhsOself :: FunctionBinding + _lhsOself = rule280 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule281 _lhsIresolveErrors + __result_ = T_FunctionBinding_vOut55 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule279 #-} + rule279 = \ ((_rangeIself) :: Range) id_ -> + FunctionBinding_Hole _rangeIself id_ + {-# INLINE rule280 #-} + rule280 = \ _self -> + _self + {-# INLINE rule281 #-} + rule281 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_FunctionBinding_Feedback #-} +sem_FunctionBinding_Feedback :: T_Range -> (String) -> T_FunctionBinding -> T_FunctionBinding +sem_FunctionBinding_Feedback arg_range_ arg_feedback_ arg_functionBinding_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionBindingX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_functionBinding_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBinding_vOut55 _functionBindingIresolveErrors _functionBindingIself) = inv_FunctionBinding_s56 _functionBindingX56 (T_FunctionBinding_vIn55 _functionBindingOopTable _functionBindingOresolveErrors) + _self = rule282 _functionBindingIself _rangeIself arg_feedback_ + _lhsOself :: FunctionBinding + _lhsOself = rule283 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule284 _functionBindingIresolveErrors + _functionBindingOopTable = rule285 _lhsIopTable + _functionBindingOresolveErrors = rule286 _lhsIresolveErrors + __result_ = T_FunctionBinding_vOut55 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule282 #-} + rule282 = \ ((_functionBindingIself) :: FunctionBinding) ((_rangeIself) :: Range) feedback_ -> + FunctionBinding_Feedback _rangeIself feedback_ _functionBindingIself + {-# INLINE rule283 #-} + rule283 = \ _self -> + _self + {-# INLINE rule284 #-} + rule284 = \ ((_functionBindingIresolveErrors) :: [ResolveError] ) -> + _functionBindingIresolveErrors + {-# INLINE rule285 #-} + rule285 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule286 #-} + rule286 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_FunctionBinding_FunctionBinding #-} +sem_FunctionBinding_FunctionBinding :: T_Range -> T_LeftHandSide -> T_RightHandSide -> T_FunctionBinding +sem_FunctionBinding_FunctionBinding arg_range_ arg_lefthandside_ arg_righthandside_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIresolveErrors _lefthandsideIself) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 _lefthandsideOopTable _lefthandsideOresolveErrors) + (T_RightHandSide_vOut148 _righthandsideIresolveErrors _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOopTable _righthandsideOresolveErrors) + _self = rule287 _lefthandsideIself _rangeIself _righthandsideIself + _lhsOself :: FunctionBinding + _lhsOself = rule288 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule289 _righthandsideIresolveErrors + _lefthandsideOopTable = rule290 _lhsIopTable + _lefthandsideOresolveErrors = rule291 _lhsIresolveErrors + _righthandsideOopTable = rule292 _lhsIopTable + _righthandsideOresolveErrors = rule293 _lefthandsideIresolveErrors + __result_ = T_FunctionBinding_vOut55 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule287 #-} + rule287 = \ ((_lefthandsideIself) :: LeftHandSide) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + FunctionBinding_FunctionBinding _rangeIself _lefthandsideIself _righthandsideIself + {-# INLINE rule288 #-} + rule288 = \ _self -> + _self + {-# INLINE rule289 #-} + rule289 = \ ((_righthandsideIresolveErrors) :: [ResolveError] ) -> + _righthandsideIresolveErrors + {-# INLINE rule290 #-} + rule290 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule291 #-} + rule291 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule292 #-} + rule292 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule293 #-} + rule293 = \ ((_lefthandsideIresolveErrors) :: [ResolveError] ) -> + _lefthandsideIresolveErrors + +-- FunctionBindings -------------------------------------------- +-- wrapper +data Inh_FunctionBindings = Inh_FunctionBindings { opTable_Inh_FunctionBindings :: (OperatorTable), resolveErrors_Inh_FunctionBindings :: ( [ResolveError] ) } +data Syn_FunctionBindings = Syn_FunctionBindings { resolveErrors_Syn_FunctionBindings :: ( [ResolveError] ), self_Syn_FunctionBindings :: (FunctionBindings) } +{-# INLINABLE wrap_FunctionBindings #-} +wrap_FunctionBindings :: T_FunctionBindings -> Inh_FunctionBindings -> (Syn_FunctionBindings ) +wrap_FunctionBindings (T_FunctionBindings act) (Inh_FunctionBindings _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBindings_vIn58 _lhsIopTable _lhsIresolveErrors + (T_FunctionBindings_vOut58 _lhsOresolveErrors _lhsOself) <- return (inv_FunctionBindings_s59 sem arg) + return (Syn_FunctionBindings _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBindings #-} +sem_FunctionBindings :: FunctionBindings -> T_FunctionBindings +sem_FunctionBindings list = Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list) + +-- semantic domain +newtype T_FunctionBindings = T_FunctionBindings { + attach_T_FunctionBindings :: Identity (T_FunctionBindings_s59 ) + } +newtype T_FunctionBindings_s59 = C_FunctionBindings_s59 { + inv_FunctionBindings_s59 :: (T_FunctionBindings_v58 ) + } +data T_FunctionBindings_s60 = C_FunctionBindings_s60 +type T_FunctionBindings_v58 = (T_FunctionBindings_vIn58 ) -> (T_FunctionBindings_vOut58 ) +data T_FunctionBindings_vIn58 = T_FunctionBindings_vIn58 (OperatorTable) ( [ResolveError] ) +data T_FunctionBindings_vOut58 = T_FunctionBindings_vOut58 ( [ResolveError] ) (FunctionBindings) +{-# NOINLINE sem_FunctionBindings_Cons #-} +sem_FunctionBindings_Cons :: T_FunctionBinding -> T_FunctionBindings -> T_FunctionBindings +sem_FunctionBindings_Cons arg_hd_ arg_tl_ = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 _lhsIopTable _lhsIresolveErrors) -> ( let + _hdX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_hd_)) + _tlX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_tl_)) + (T_FunctionBinding_vOut55 _hdIresolveErrors _hdIself) = inv_FunctionBinding_s56 _hdX56 (T_FunctionBinding_vIn55 _hdOopTable _hdOresolveErrors) + (T_FunctionBindings_vOut58 _tlIresolveErrors _tlIself) = inv_FunctionBindings_s59 _tlX59 (T_FunctionBindings_vIn58 _tlOopTable _tlOresolveErrors) + _self = rule294 _hdIself _tlIself + _lhsOself :: FunctionBindings + _lhsOself = rule295 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule296 _tlIresolveErrors + _hdOopTable = rule297 _lhsIopTable + _hdOresolveErrors = rule298 _lhsIresolveErrors + _tlOopTable = rule299 _lhsIopTable + _tlOresolveErrors = rule300 _hdIresolveErrors + __result_ = T_FunctionBindings_vOut58 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule294 #-} + rule294 = \ ((_hdIself) :: FunctionBinding) ((_tlIself) :: FunctionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule295 #-} + rule295 = \ _self -> + _self + {-# INLINE rule296 #-} + rule296 = \ ((_tlIresolveErrors) :: [ResolveError] ) -> + _tlIresolveErrors + {-# INLINE rule297 #-} + rule297 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule298 #-} + rule298 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule299 #-} + rule299 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule300 #-} + rule300 = \ ((_hdIresolveErrors) :: [ResolveError] ) -> + _hdIresolveErrors +{-# NOINLINE sem_FunctionBindings_Nil #-} +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule301 () + _lhsOself :: FunctionBindings + _lhsOself = rule302 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule303 _lhsIresolveErrors + __result_ = T_FunctionBindings_vOut58 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule301 #-} + rule301 = \ (_ :: ()) -> + [] + {-# INLINE rule302 #-} + rule302 = \ _self -> + _self + {-# INLINE rule303 #-} + rule303 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- GuardedExpression ------------------------------------------- +-- wrapper +data Inh_GuardedExpression = Inh_GuardedExpression { opTable_Inh_GuardedExpression :: (OperatorTable), resolveErrors_Inh_GuardedExpression :: ( [ResolveError] ) } +data Syn_GuardedExpression = Syn_GuardedExpression { resolveErrors_Syn_GuardedExpression :: ( [ResolveError] ), self_Syn_GuardedExpression :: (GuardedExpression) } +{-# INLINABLE wrap_GuardedExpression #-} +wrap_GuardedExpression :: T_GuardedExpression -> Inh_GuardedExpression -> (Syn_GuardedExpression ) +wrap_GuardedExpression (T_GuardedExpression act) (Inh_GuardedExpression _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpression_vIn61 _lhsIopTable _lhsIresolveErrors + (T_GuardedExpression_vOut61 _lhsOresolveErrors _lhsOself) <- return (inv_GuardedExpression_s62 sem arg) + return (Syn_GuardedExpression _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpression #-} +sem_GuardedExpression :: GuardedExpression -> T_GuardedExpression +sem_GuardedExpression ( GuardedExpression_GuardedExpression range_ guard_ expression_ ) = sem_GuardedExpression_GuardedExpression ( sem_Range range_ ) ( sem_Expression guard_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_GuardedExpression = T_GuardedExpression { + attach_T_GuardedExpression :: Identity (T_GuardedExpression_s62 ) + } +newtype T_GuardedExpression_s62 = C_GuardedExpression_s62 { + inv_GuardedExpression_s62 :: (T_GuardedExpression_v61 ) + } +data T_GuardedExpression_s63 = C_GuardedExpression_s63 +type T_GuardedExpression_v61 = (T_GuardedExpression_vIn61 ) -> (T_GuardedExpression_vOut61 ) +data T_GuardedExpression_vIn61 = T_GuardedExpression_vIn61 (OperatorTable) ( [ResolveError] ) +data T_GuardedExpression_vOut61 = T_GuardedExpression_vOut61 ( [ResolveError] ) (GuardedExpression) +{-# NOINLINE sem_GuardedExpression_GuardedExpression #-} +sem_GuardedExpression_GuardedExpression :: T_Range -> T_Expression -> T_Expression -> T_GuardedExpression +sem_GuardedExpression_GuardedExpression arg_range_ arg_guard_ arg_expression_ = T_GuardedExpression (return st62) where + {-# NOINLINE st62 #-} + st62 = let + v61 :: T_GuardedExpression_v61 + v61 = \ (T_GuardedExpression_vIn61 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIresolveErrors _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 _guardOopTable _guardOresolveErrors) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule304 _expressionIself _guardIself _rangeIself + _lhsOself :: GuardedExpression + _lhsOself = rule305 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule306 _expressionIresolveErrors + _guardOopTable = rule307 _lhsIopTable + _guardOresolveErrors = rule308 _lhsIresolveErrors + _expressionOopTable = rule309 _lhsIopTable + _expressionOresolveErrors = rule310 _guardIresolveErrors + __result_ = T_GuardedExpression_vOut61 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_GuardedExpression_s62 v61 + {-# INLINE rule304 #-} + rule304 = \ ((_expressionIself) :: Expression) ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + GuardedExpression_GuardedExpression _rangeIself _guardIself _expressionIself + {-# INLINE rule305 #-} + rule305 = \ _self -> + _self + {-# INLINE rule306 #-} + rule306 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule307 #-} + rule307 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule308 #-} + rule308 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule309 #-} + rule309 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule310 #-} + rule310 = \ ((_guardIresolveErrors) :: [ResolveError] ) -> + _guardIresolveErrors + +-- GuardedExpressions ------------------------------------------ +-- wrapper +data Inh_GuardedExpressions = Inh_GuardedExpressions { opTable_Inh_GuardedExpressions :: (OperatorTable), resolveErrors_Inh_GuardedExpressions :: ( [ResolveError] ) } +data Syn_GuardedExpressions = Syn_GuardedExpressions { resolveErrors_Syn_GuardedExpressions :: ( [ResolveError] ), self_Syn_GuardedExpressions :: (GuardedExpressions) } +{-# INLINABLE wrap_GuardedExpressions #-} +wrap_GuardedExpressions :: T_GuardedExpressions -> Inh_GuardedExpressions -> (Syn_GuardedExpressions ) +wrap_GuardedExpressions (T_GuardedExpressions act) (Inh_GuardedExpressions _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpressions_vIn64 _lhsIopTable _lhsIresolveErrors + (T_GuardedExpressions_vOut64 _lhsOresolveErrors _lhsOself) <- return (inv_GuardedExpressions_s65 sem arg) + return (Syn_GuardedExpressions _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpressions #-} +sem_GuardedExpressions :: GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions list = Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list) + +-- semantic domain +newtype T_GuardedExpressions = T_GuardedExpressions { + attach_T_GuardedExpressions :: Identity (T_GuardedExpressions_s65 ) + } +newtype T_GuardedExpressions_s65 = C_GuardedExpressions_s65 { + inv_GuardedExpressions_s65 :: (T_GuardedExpressions_v64 ) + } +data T_GuardedExpressions_s66 = C_GuardedExpressions_s66 +type T_GuardedExpressions_v64 = (T_GuardedExpressions_vIn64 ) -> (T_GuardedExpressions_vOut64 ) +data T_GuardedExpressions_vIn64 = T_GuardedExpressions_vIn64 (OperatorTable) ( [ResolveError] ) +data T_GuardedExpressions_vOut64 = T_GuardedExpressions_vOut64 ( [ResolveError] ) (GuardedExpressions) +{-# NOINLINE sem_GuardedExpressions_Cons #-} +sem_GuardedExpressions_Cons :: T_GuardedExpression -> T_GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions_Cons arg_hd_ arg_tl_ = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 _lhsIopTable _lhsIresolveErrors) -> ( let + _hdX62 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpression (arg_hd_)) + _tlX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_tl_)) + (T_GuardedExpression_vOut61 _hdIresolveErrors _hdIself) = inv_GuardedExpression_s62 _hdX62 (T_GuardedExpression_vIn61 _hdOopTable _hdOresolveErrors) + (T_GuardedExpressions_vOut64 _tlIresolveErrors _tlIself) = inv_GuardedExpressions_s65 _tlX65 (T_GuardedExpressions_vIn64 _tlOopTable _tlOresolveErrors) + _self = rule311 _hdIself _tlIself + _lhsOself :: GuardedExpressions + _lhsOself = rule312 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule313 _tlIresolveErrors + _hdOopTable = rule314 _lhsIopTable + _hdOresolveErrors = rule315 _lhsIresolveErrors + _tlOopTable = rule316 _lhsIopTable + _tlOresolveErrors = rule317 _hdIresolveErrors + __result_ = T_GuardedExpressions_vOut64 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule311 #-} + rule311 = \ ((_hdIself) :: GuardedExpression) ((_tlIself) :: GuardedExpressions) -> + (:) _hdIself _tlIself + {-# INLINE rule312 #-} + rule312 = \ _self -> + _self + {-# INLINE rule313 #-} + rule313 = \ ((_tlIresolveErrors) :: [ResolveError] ) -> + _tlIresolveErrors + {-# INLINE rule314 #-} + rule314 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule315 #-} + rule315 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule316 #-} + rule316 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule317 #-} + rule317 = \ ((_hdIresolveErrors) :: [ResolveError] ) -> + _hdIresolveErrors +{-# NOINLINE sem_GuardedExpressions_Nil #-} +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule318 () + _lhsOself :: GuardedExpressions + _lhsOself = rule319 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule320 _lhsIresolveErrors + __result_ = T_GuardedExpressions_vOut64 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule318 #-} + rule318 = \ (_ :: ()) -> + [] + {-# INLINE rule319 #-} + rule319 = \ _self -> + _self + {-# INLINE rule320 #-} + rule320 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Import ------------------------------------------------------ +-- wrapper +data Inh_Import = Inh_Import { } +data Syn_Import = Syn_Import { self_Syn_Import :: (Import) } +{-# INLINABLE wrap_Import #-} +wrap_Import :: T_Import -> Inh_Import -> (Syn_Import ) +wrap_Import (T_Import act) (Inh_Import ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Import_vIn67 + (T_Import_vOut67 _lhsOself) <- return (inv_Import_s68 sem arg) + return (Syn_Import _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Import #-} +sem_Import :: Import -> T_Import +sem_Import ( Import_Variable range_ name_ ) = sem_Import_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Import ( Import_TypeOrClass range_ name_ names_ ) = sem_Import_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Import ( Import_TypeOrClassComplete range_ name_ ) = sem_Import_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Import = T_Import { + attach_T_Import :: Identity (T_Import_s68 ) + } +newtype T_Import_s68 = C_Import_s68 { + inv_Import_s68 :: (T_Import_v67 ) + } +data T_Import_s69 = C_Import_s69 +type T_Import_v67 = (T_Import_vIn67 ) -> (T_Import_vOut67 ) +data T_Import_vIn67 = T_Import_vIn67 +data T_Import_vOut67 = T_Import_vOut67 (Import) +{-# NOINLINE sem_Import_Variable #-} +sem_Import_Variable :: T_Range -> T_Name -> T_Import +sem_Import_Variable arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule321 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule322 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule321 #-} + rule321 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_Variable _rangeIself _nameIself + {-# INLINE rule322 #-} + rule322 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClass #-} +sem_Import_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Import +sem_Import_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _self = rule323 _nameIself _namesIself _rangeIself + _lhsOself :: Import + _lhsOself = rule324 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule323 #-} + rule323 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Import_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule324 #-} + rule324 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClassComplete #-} +sem_Import_TypeOrClassComplete :: T_Range -> T_Name -> T_Import +sem_Import_TypeOrClassComplete arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule325 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule326 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule325 #-} + rule325 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule326 #-} + rule326 = \ _self -> + _self + +-- ImportDeclaration ------------------------------------------- +-- wrapper +data Inh_ImportDeclaration = Inh_ImportDeclaration { } +data Syn_ImportDeclaration = Syn_ImportDeclaration { self_Syn_ImportDeclaration :: (ImportDeclaration) } +{-# INLINABLE wrap_ImportDeclaration #-} +wrap_ImportDeclaration :: T_ImportDeclaration -> Inh_ImportDeclaration -> (Syn_ImportDeclaration ) +wrap_ImportDeclaration (T_ImportDeclaration act) (Inh_ImportDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclaration_vIn70 + (T_ImportDeclaration_vOut70 _lhsOself) <- return (inv_ImportDeclaration_s71 sem arg) + return (Syn_ImportDeclaration _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclaration #-} +sem_ImportDeclaration :: ImportDeclaration -> T_ImportDeclaration +sem_ImportDeclaration ( ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ ) = sem_ImportDeclaration_Import ( sem_Range range_ ) qualified_ ( sem_Name name_ ) ( sem_MaybeName asname_ ) ( sem_MaybeImportSpecification importspecification_ ) +sem_ImportDeclaration ( ImportDeclaration_Empty range_ ) = sem_ImportDeclaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_ImportDeclaration = T_ImportDeclaration { + attach_T_ImportDeclaration :: Identity (T_ImportDeclaration_s71 ) + } +newtype T_ImportDeclaration_s71 = C_ImportDeclaration_s71 { + inv_ImportDeclaration_s71 :: (T_ImportDeclaration_v70 ) + } +data T_ImportDeclaration_s72 = C_ImportDeclaration_s72 +type T_ImportDeclaration_v70 = (T_ImportDeclaration_vIn70 ) -> (T_ImportDeclaration_vOut70 ) +data T_ImportDeclaration_vIn70 = T_ImportDeclaration_vIn70 +data T_ImportDeclaration_vOut70 = T_ImportDeclaration_vOut70 (ImportDeclaration) +{-# NOINLINE sem_ImportDeclaration_Import #-} +sem_ImportDeclaration_Import :: T_Range -> (Bool) -> T_Name -> T_MaybeName -> T_MaybeImportSpecification -> T_ImportDeclaration +sem_ImportDeclaration_Import arg_range_ arg_qualified_ arg_name_ arg_asname_ arg_importspecification_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _asnameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_asname_)) + _importspecificationX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeImportSpecification (arg_importspecification_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeName_vOut103 _asnameIself) = inv_MaybeName_s104 _asnameX104 (T_MaybeName_vIn103 ) + (T_MaybeImportSpecification_vOut97 _importspecificationIself) = inv_MaybeImportSpecification_s98 _importspecificationX98 (T_MaybeImportSpecification_vIn97 ) + _self = rule327 _asnameIself _importspecificationIself _nameIself _rangeIself arg_qualified_ + _lhsOself :: ImportDeclaration + _lhsOself = rule328 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule327 #-} + rule327 = \ ((_asnameIself) :: MaybeName) ((_importspecificationIself) :: MaybeImportSpecification) ((_nameIself) :: Name) ((_rangeIself) :: Range) qualified_ -> + ImportDeclaration_Import _rangeIself qualified_ _nameIself _asnameIself _importspecificationIself + {-# INLINE rule328 #-} + rule328 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclaration_Empty #-} +sem_ImportDeclaration_Empty :: T_Range -> T_ImportDeclaration +sem_ImportDeclaration_Empty arg_range_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule329 _rangeIself + _lhsOself :: ImportDeclaration + _lhsOself = rule330 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule329 #-} + rule329 = \ ((_rangeIself) :: Range) -> + ImportDeclaration_Empty _rangeIself + {-# INLINE rule330 #-} + rule330 = \ _self -> + _self + +-- ImportDeclarations ------------------------------------------ +-- wrapper +data Inh_ImportDeclarations = Inh_ImportDeclarations { } +data Syn_ImportDeclarations = Syn_ImportDeclarations { self_Syn_ImportDeclarations :: (ImportDeclarations) } +{-# INLINABLE wrap_ImportDeclarations #-} +wrap_ImportDeclarations :: T_ImportDeclarations -> Inh_ImportDeclarations -> (Syn_ImportDeclarations ) +wrap_ImportDeclarations (T_ImportDeclarations act) (Inh_ImportDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclarations_vIn73 + (T_ImportDeclarations_vOut73 _lhsOself) <- return (inv_ImportDeclarations_s74 sem arg) + return (Syn_ImportDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclarations #-} +sem_ImportDeclarations :: ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations list = Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list) + +-- semantic domain +newtype T_ImportDeclarations = T_ImportDeclarations { + attach_T_ImportDeclarations :: Identity (T_ImportDeclarations_s74 ) + } +newtype T_ImportDeclarations_s74 = C_ImportDeclarations_s74 { + inv_ImportDeclarations_s74 :: (T_ImportDeclarations_v73 ) + } +data T_ImportDeclarations_s75 = C_ImportDeclarations_s75 +type T_ImportDeclarations_v73 = (T_ImportDeclarations_vIn73 ) -> (T_ImportDeclarations_vOut73 ) +data T_ImportDeclarations_vIn73 = T_ImportDeclarations_vIn73 +data T_ImportDeclarations_vOut73 = T_ImportDeclarations_vOut73 (ImportDeclarations) +{-# NOINLINE sem_ImportDeclarations_Cons #-} +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> T_ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations_Cons arg_hd_ arg_tl_ = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _hdX71 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclaration (arg_hd_)) + _tlX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_tl_)) + (T_ImportDeclaration_vOut70 _hdIself) = inv_ImportDeclaration_s71 _hdX71 (T_ImportDeclaration_vIn70 ) + (T_ImportDeclarations_vOut73 _tlIself) = inv_ImportDeclarations_s74 _tlX74 (T_ImportDeclarations_vIn73 ) + _self = rule331 _hdIself _tlIself + _lhsOself :: ImportDeclarations + _lhsOself = rule332 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule331 #-} + rule331 = \ ((_hdIself) :: ImportDeclaration) ((_tlIself) :: ImportDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule332 #-} + rule332 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclarations_Nil #-} +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _self = rule333 () + _lhsOself :: ImportDeclarations + _lhsOself = rule334 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule333 #-} + rule333 = \ (_ :: ()) -> + [] + {-# INLINE rule334 #-} + rule334 = \ _self -> + _self + +-- ImportSpecification ----------------------------------------- +-- wrapper +data Inh_ImportSpecification = Inh_ImportSpecification { } +data Syn_ImportSpecification = Syn_ImportSpecification { self_Syn_ImportSpecification :: (ImportSpecification) } +{-# INLINABLE wrap_ImportSpecification #-} +wrap_ImportSpecification :: T_ImportSpecification -> Inh_ImportSpecification -> (Syn_ImportSpecification ) +wrap_ImportSpecification (T_ImportSpecification act) (Inh_ImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportSpecification_vIn76 + (T_ImportSpecification_vOut76 _lhsOself) <- return (inv_ImportSpecification_s77 sem arg) + return (Syn_ImportSpecification _lhsOself) + ) + +-- cata +{-# INLINE sem_ImportSpecification #-} +sem_ImportSpecification :: ImportSpecification -> T_ImportSpecification +sem_ImportSpecification ( ImportSpecification_Import range_ hiding_ imports_ ) = sem_ImportSpecification_Import ( sem_Range range_ ) hiding_ ( sem_Imports imports_ ) + +-- semantic domain +newtype T_ImportSpecification = T_ImportSpecification { + attach_T_ImportSpecification :: Identity (T_ImportSpecification_s77 ) + } +newtype T_ImportSpecification_s77 = C_ImportSpecification_s77 { + inv_ImportSpecification_s77 :: (T_ImportSpecification_v76 ) + } +data T_ImportSpecification_s78 = C_ImportSpecification_s78 +type T_ImportSpecification_v76 = (T_ImportSpecification_vIn76 ) -> (T_ImportSpecification_vOut76 ) +data T_ImportSpecification_vIn76 = T_ImportSpecification_vIn76 +data T_ImportSpecification_vOut76 = T_ImportSpecification_vOut76 (ImportSpecification) +{-# NOINLINE sem_ImportSpecification_Import #-} +sem_ImportSpecification_Import :: T_Range -> (Bool) -> T_Imports -> T_ImportSpecification +sem_ImportSpecification_Import arg_range_ arg_hiding_ arg_imports_ = T_ImportSpecification (return st77) where + {-# NOINLINE st77 #-} + st77 = let + v76 :: T_ImportSpecification_v76 + v76 = \ (T_ImportSpecification_vIn76 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importsX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_imports_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Imports_vOut79 _importsIself) = inv_Imports_s80 _importsX80 (T_Imports_vIn79 ) + _self = rule335 _importsIself _rangeIself arg_hiding_ + _lhsOself :: ImportSpecification + _lhsOself = rule336 _self + __result_ = T_ImportSpecification_vOut76 _lhsOself + in __result_ ) + in C_ImportSpecification_s77 v76 + {-# INLINE rule335 #-} + rule335 = \ ((_importsIself) :: Imports) ((_rangeIself) :: Range) hiding_ -> + ImportSpecification_Import _rangeIself hiding_ _importsIself + {-# INLINE rule336 #-} + rule336 = \ _self -> + _self + +-- Imports ----------------------------------------------------- +-- wrapper +data Inh_Imports = Inh_Imports { } +data Syn_Imports = Syn_Imports { self_Syn_Imports :: (Imports) } +{-# INLINABLE wrap_Imports #-} +wrap_Imports :: T_Imports -> Inh_Imports -> (Syn_Imports ) +wrap_Imports (T_Imports act) (Inh_Imports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Imports_vIn79 + (T_Imports_vOut79 _lhsOself) <- return (inv_Imports_s80 sem arg) + return (Syn_Imports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Imports #-} +sem_Imports :: Imports -> T_Imports +sem_Imports list = Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list) + +-- semantic domain +newtype T_Imports = T_Imports { + attach_T_Imports :: Identity (T_Imports_s80 ) + } +newtype T_Imports_s80 = C_Imports_s80 { + inv_Imports_s80 :: (T_Imports_v79 ) + } +data T_Imports_s81 = C_Imports_s81 +type T_Imports_v79 = (T_Imports_vIn79 ) -> (T_Imports_vOut79 ) +data T_Imports_vIn79 = T_Imports_vIn79 +data T_Imports_vOut79 = T_Imports_vOut79 (Imports) +{-# NOINLINE sem_Imports_Cons #-} +sem_Imports_Cons :: T_Import -> T_Imports -> T_Imports +sem_Imports_Cons arg_hd_ arg_tl_ = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _hdX68 = Control.Monad.Identity.runIdentity (attach_T_Import (arg_hd_)) + _tlX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_tl_)) + (T_Import_vOut67 _hdIself) = inv_Import_s68 _hdX68 (T_Import_vIn67 ) + (T_Imports_vOut79 _tlIself) = inv_Imports_s80 _tlX80 (T_Imports_vIn79 ) + _self = rule337 _hdIself _tlIself + _lhsOself :: Imports + _lhsOself = rule338 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule337 #-} + rule337 = \ ((_hdIself) :: Import) ((_tlIself) :: Imports) -> + (:) _hdIself _tlIself + {-# INLINE rule338 #-} + rule338 = \ _self -> + _self +{-# NOINLINE sem_Imports_Nil #-} +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _self = rule339 () + _lhsOself :: Imports + _lhsOself = rule340 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule339 #-} + rule339 = \ (_ :: ()) -> + [] + {-# INLINE rule340 #-} + rule340 = \ _self -> + _self + +-- LeftHandSide ------------------------------------------------ +-- wrapper +data Inh_LeftHandSide = Inh_LeftHandSide { opTable_Inh_LeftHandSide :: (OperatorTable), resolveErrors_Inh_LeftHandSide :: ( [ResolveError] ) } +data Syn_LeftHandSide = Syn_LeftHandSide { resolveErrors_Syn_LeftHandSide :: ( [ResolveError] ), self_Syn_LeftHandSide :: (LeftHandSide) } +{-# INLINABLE wrap_LeftHandSide #-} +wrap_LeftHandSide :: T_LeftHandSide -> Inh_LeftHandSide -> (Syn_LeftHandSide ) +wrap_LeftHandSide (T_LeftHandSide act) (Inh_LeftHandSide _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_LeftHandSide_vIn82 _lhsIopTable _lhsIresolveErrors + (T_LeftHandSide_vOut82 _lhsOresolveErrors _lhsOself) <- return (inv_LeftHandSide_s83 sem arg) + return (Syn_LeftHandSide _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_LeftHandSide #-} +sem_LeftHandSide :: LeftHandSide -> T_LeftHandSide +sem_LeftHandSide ( LeftHandSide_Function range_ name_ patterns_ ) = sem_LeftHandSide_Function ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_LeftHandSide ( LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ ) = sem_LeftHandSide_Infix ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name operator_ ) ( sem_Pattern rightPattern_ ) +sem_LeftHandSide ( LeftHandSide_Parenthesized range_ lefthandside_ patterns_ ) = sem_LeftHandSide_Parenthesized ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_Patterns patterns_ ) + +-- semantic domain +newtype T_LeftHandSide = T_LeftHandSide { + attach_T_LeftHandSide :: Identity (T_LeftHandSide_s83 ) + } +newtype T_LeftHandSide_s83 = C_LeftHandSide_s83 { + inv_LeftHandSide_s83 :: (T_LeftHandSide_v82 ) + } +data T_LeftHandSide_s84 = C_LeftHandSide_s84 +type T_LeftHandSide_v82 = (T_LeftHandSide_vIn82 ) -> (T_LeftHandSide_vOut82 ) +data T_LeftHandSide_vIn82 = T_LeftHandSide_vIn82 (OperatorTable) ( [ResolveError] ) +data T_LeftHandSide_vOut82 = T_LeftHandSide_vOut82 ( [ResolveError] ) (LeftHandSide) +{-# NOINLINE sem_LeftHandSide_Function #-} +sem_LeftHandSide_Function :: T_Range -> T_Name -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Function arg_range_ arg_name_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIresolveErrors _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOopTable _patternsOresolveErrors) + _self = rule341 _nameIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule342 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule343 _patternsIresolveErrors + _patternsOopTable = rule344 _lhsIopTable + _patternsOresolveErrors = rule345 _lhsIresolveErrors + __result_ = T_LeftHandSide_vOut82 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule341 #-} + rule341 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Function _rangeIself _nameIself _patternsIself + {-# INLINE rule342 #-} + rule342 = \ _self -> + _self + {-# INLINE rule343 #-} + rule343 = \ ((_patternsIresolveErrors) :: [ResolveError] ) -> + _patternsIresolveErrors + {-# INLINE rule344 #-} + rule344 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule345 #-} + rule345 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_LeftHandSide_Infix #-} +sem_LeftHandSide_Infix :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_LeftHandSide +sem_LeftHandSide_Infix arg_range_ arg_leftPattern_ arg_operator_ arg_rightPattern_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _operatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_operator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIresolveErrors _leftPatternIself) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 _leftPatternOopTable _leftPatternOresolveErrors) + (T_Name_vOut112 _operatorIself) = inv_Name_s113 _operatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIresolveErrors _rightPatternIself) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 _rightPatternOopTable _rightPatternOresolveErrors) + _self = rule346 _leftPatternIself _operatorIself _rangeIself _rightPatternIself + _lhsOself :: LeftHandSide + _lhsOself = rule347 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule348 _rightPatternIresolveErrors + _leftPatternOopTable = rule349 _lhsIopTable + _leftPatternOresolveErrors = rule350 _lhsIresolveErrors + _rightPatternOopTable = rule351 _lhsIopTable + _rightPatternOresolveErrors = rule352 _leftPatternIresolveErrors + __result_ = T_LeftHandSide_vOut82 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule346 #-} + rule346 = \ ((_leftPatternIself) :: Pattern) ((_operatorIself) :: Name) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + LeftHandSide_Infix _rangeIself _leftPatternIself _operatorIself _rightPatternIself + {-# INLINE rule347 #-} + rule347 = \ _self -> + _self + {-# INLINE rule348 #-} + rule348 = \ ((_rightPatternIresolveErrors) :: [ResolveError] ) -> + _rightPatternIresolveErrors + {-# INLINE rule349 #-} + rule349 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule350 #-} + rule350 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule351 #-} + rule351 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule352 #-} + rule352 = \ ((_leftPatternIresolveErrors) :: [ResolveError] ) -> + _leftPatternIresolveErrors +{-# NOINLINE sem_LeftHandSide_Parenthesized #-} +sem_LeftHandSide_Parenthesized :: T_Range -> T_LeftHandSide -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Parenthesized arg_range_ arg_lefthandside_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIresolveErrors _lefthandsideIself) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 _lefthandsideOopTable _lefthandsideOresolveErrors) + (T_Patterns_vOut121 _patternsIresolveErrors _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOopTable _patternsOresolveErrors) + _self = rule353 _lefthandsideIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule354 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule355 _patternsIresolveErrors + _lefthandsideOopTable = rule356 _lhsIopTable + _lefthandsideOresolveErrors = rule357 _lhsIresolveErrors + _patternsOopTable = rule358 _lhsIopTable + _patternsOresolveErrors = rule359 _lefthandsideIresolveErrors + __result_ = T_LeftHandSide_vOut82 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule353 #-} + rule353 = \ ((_lefthandsideIself) :: LeftHandSide) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Parenthesized _rangeIself _lefthandsideIself _patternsIself + {-# INLINE rule354 #-} + rule354 = \ _self -> + _self + {-# INLINE rule355 #-} + rule355 = \ ((_patternsIresolveErrors) :: [ResolveError] ) -> + _patternsIresolveErrors + {-# INLINE rule356 #-} + rule356 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule357 #-} + rule357 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule358 #-} + rule358 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule359 #-} + rule359 = \ ((_lefthandsideIresolveErrors) :: [ResolveError] ) -> + _lefthandsideIresolveErrors + +-- Literal ----------------------------------------------------- +-- wrapper +data Inh_Literal = Inh_Literal { } +data Syn_Literal = Syn_Literal { self_Syn_Literal :: (Literal) } +{-# INLINABLE wrap_Literal #-} +wrap_Literal :: T_Literal -> Inh_Literal -> (Syn_Literal ) +wrap_Literal (T_Literal act) (Inh_Literal ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Literal_vIn85 + (T_Literal_vOut85 _lhsOself) <- return (inv_Literal_s86 sem arg) + return (Syn_Literal _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Literal #-} +sem_Literal :: Literal -> T_Literal +sem_Literal ( Literal_Int range_ value_ ) = sem_Literal_Int ( sem_Range range_ ) value_ +sem_Literal ( Literal_Char range_ value_ ) = sem_Literal_Char ( sem_Range range_ ) value_ +sem_Literal ( Literal_Float range_ value_ ) = sem_Literal_Float ( sem_Range range_ ) value_ +sem_Literal ( Literal_String range_ value_ ) = sem_Literal_String ( sem_Range range_ ) value_ + +-- semantic domain +newtype T_Literal = T_Literal { + attach_T_Literal :: Identity (T_Literal_s86 ) + } +newtype T_Literal_s86 = C_Literal_s86 { + inv_Literal_s86 :: (T_Literal_v85 ) + } +data T_Literal_s87 = C_Literal_s87 +type T_Literal_v85 = (T_Literal_vIn85 ) -> (T_Literal_vOut85 ) +data T_Literal_vIn85 = T_Literal_vIn85 +data T_Literal_vOut85 = T_Literal_vOut85 (Literal) +{-# NOINLINE sem_Literal_Int #-} +sem_Literal_Int :: T_Range -> (String) -> T_Literal +sem_Literal_Int arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule360 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule361 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule360 #-} + rule360 = \ ((_rangeIself) :: Range) value_ -> + Literal_Int _rangeIself value_ + {-# INLINE rule361 #-} + rule361 = \ _self -> + _self +{-# NOINLINE sem_Literal_Char #-} +sem_Literal_Char :: T_Range -> (String) -> T_Literal +sem_Literal_Char arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule362 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule363 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule362 #-} + rule362 = \ ((_rangeIself) :: Range) value_ -> + Literal_Char _rangeIself value_ + {-# INLINE rule363 #-} + rule363 = \ _self -> + _self +{-# NOINLINE sem_Literal_Float #-} +sem_Literal_Float :: T_Range -> (String) -> T_Literal +sem_Literal_Float arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule364 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule365 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule364 #-} + rule364 = \ ((_rangeIself) :: Range) value_ -> + Literal_Float _rangeIself value_ + {-# INLINE rule365 #-} + rule365 = \ _self -> + _self +{-# NOINLINE sem_Literal_String #-} +sem_Literal_String :: T_Range -> (String) -> T_Literal +sem_Literal_String arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule366 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule367 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule366 #-} + rule366 = \ ((_rangeIself) :: Range) value_ -> + Literal_String _rangeIself value_ + {-# INLINE rule367 #-} + rule367 = \ _self -> + _self + +-- MaybeDeclarations ------------------------------------------- +-- wrapper +data Inh_MaybeDeclarations = Inh_MaybeDeclarations { opTable_Inh_MaybeDeclarations :: (OperatorTable), resolveErrors_Inh_MaybeDeclarations :: ( [ResolveError] ) } +data Syn_MaybeDeclarations = Syn_MaybeDeclarations { resolveErrors_Syn_MaybeDeclarations :: ( [ResolveError] ), self_Syn_MaybeDeclarations :: (MaybeDeclarations) } +{-# INLINABLE wrap_MaybeDeclarations #-} +wrap_MaybeDeclarations :: T_MaybeDeclarations -> Inh_MaybeDeclarations -> (Syn_MaybeDeclarations ) +wrap_MaybeDeclarations (T_MaybeDeclarations act) (Inh_MaybeDeclarations _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeDeclarations_vIn88 _lhsIopTable _lhsIresolveErrors + (T_MaybeDeclarations_vOut88 _lhsOresolveErrors _lhsOself) <- return (inv_MaybeDeclarations_s89 sem arg) + return (Syn_MaybeDeclarations _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeDeclarations #-} +sem_MaybeDeclarations :: MaybeDeclarations -> T_MaybeDeclarations +sem_MaybeDeclarations ( MaybeDeclarations_Nothing ) = sem_MaybeDeclarations_Nothing +sem_MaybeDeclarations ( MaybeDeclarations_Just declarations_ ) = sem_MaybeDeclarations_Just ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_MaybeDeclarations = T_MaybeDeclarations { + attach_T_MaybeDeclarations :: Identity (T_MaybeDeclarations_s89 ) + } +newtype T_MaybeDeclarations_s89 = C_MaybeDeclarations_s89 { + inv_MaybeDeclarations_s89 :: (T_MaybeDeclarations_v88 ) + } +data T_MaybeDeclarations_s90 = C_MaybeDeclarations_s90 +type T_MaybeDeclarations_v88 = (T_MaybeDeclarations_vIn88 ) -> (T_MaybeDeclarations_vOut88 ) +data T_MaybeDeclarations_vIn88 = T_MaybeDeclarations_vIn88 (OperatorTable) ( [ResolveError] ) +data T_MaybeDeclarations_vOut88 = T_MaybeDeclarations_vOut88 ( [ResolveError] ) (MaybeDeclarations) +{-# NOINLINE sem_MaybeDeclarations_Nothing #-} +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule368 () + _lhsOself :: MaybeDeclarations + _lhsOself = rule369 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule370 _lhsIresolveErrors + __result_ = T_MaybeDeclarations_vOut88 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule368 #-} + rule368 = \ (_ :: ()) -> + MaybeDeclarations_Nothing + {-# INLINE rule369 #-} + rule369 = \ _self -> + _self + {-# INLINE rule370 #-} + rule370 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_MaybeDeclarations_Just #-} +sem_MaybeDeclarations_Just :: T_Declarations -> T_MaybeDeclarations +sem_MaybeDeclarations_Just arg_declarations_ = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 _lhsIopTable _lhsIresolveErrors) -> ( let + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Declarations_vOut31 _declarationsIresolveErrors _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOopTable _declarationsOresolveErrors) + _self = rule371 _declarationsIself + _lhsOself :: MaybeDeclarations + _lhsOself = rule372 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule373 _declarationsIresolveErrors + _declarationsOopTable = rule374 _lhsIopTable + _declarationsOresolveErrors = rule375 _lhsIresolveErrors + __result_ = T_MaybeDeclarations_vOut88 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule371 #-} + rule371 = \ ((_declarationsIself) :: Declarations) -> + MaybeDeclarations_Just _declarationsIself + {-# INLINE rule372 #-} + rule372 = \ _self -> + _self + {-# INLINE rule373 #-} + rule373 = \ ((_declarationsIresolveErrors) :: [ResolveError] ) -> + _declarationsIresolveErrors + {-# INLINE rule374 #-} + rule374 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule375 #-} + rule375 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- MaybeExports ------------------------------------------------ +-- wrapper +data Inh_MaybeExports = Inh_MaybeExports { } +data Syn_MaybeExports = Syn_MaybeExports { self_Syn_MaybeExports :: (MaybeExports) } +{-# INLINABLE wrap_MaybeExports #-} +wrap_MaybeExports :: T_MaybeExports -> Inh_MaybeExports -> (Syn_MaybeExports ) +wrap_MaybeExports (T_MaybeExports act) (Inh_MaybeExports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExports_vIn91 + (T_MaybeExports_vOut91 _lhsOself) <- return (inv_MaybeExports_s92 sem arg) + return (Syn_MaybeExports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExports #-} +sem_MaybeExports :: MaybeExports -> T_MaybeExports +sem_MaybeExports ( MaybeExports_Nothing ) = sem_MaybeExports_Nothing +sem_MaybeExports ( MaybeExports_Just exports_ ) = sem_MaybeExports_Just ( sem_Exports exports_ ) + +-- semantic domain +newtype T_MaybeExports = T_MaybeExports { + attach_T_MaybeExports :: Identity (T_MaybeExports_s92 ) + } +newtype T_MaybeExports_s92 = C_MaybeExports_s92 { + inv_MaybeExports_s92 :: (T_MaybeExports_v91 ) + } +data T_MaybeExports_s93 = C_MaybeExports_s93 +type T_MaybeExports_v91 = (T_MaybeExports_vIn91 ) -> (T_MaybeExports_vOut91 ) +data T_MaybeExports_vIn91 = T_MaybeExports_vIn91 +data T_MaybeExports_vOut91 = T_MaybeExports_vOut91 (MaybeExports) +{-# NOINLINE sem_MaybeExports_Nothing #-} +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _self = rule376 () + _lhsOself :: MaybeExports + _lhsOself = rule377 _self + __result_ = T_MaybeExports_vOut91 _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule376 #-} + rule376 = \ (_ :: ()) -> + MaybeExports_Nothing + {-# INLINE rule377 #-} + rule377 = \ _self -> + _self +{-# NOINLINE sem_MaybeExports_Just #-} +sem_MaybeExports_Just :: T_Exports -> T_MaybeExports +sem_MaybeExports_Just arg_exports_ = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _exportsX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_exports_)) + (T_Exports_vOut37 _exportsIself) = inv_Exports_s38 _exportsX38 (T_Exports_vIn37 ) + _self = rule378 _exportsIself + _lhsOself :: MaybeExports + _lhsOself = rule379 _self + __result_ = T_MaybeExports_vOut91 _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule378 #-} + rule378 = \ ((_exportsIself) :: Exports) -> + MaybeExports_Just _exportsIself + {-# INLINE rule379 #-} + rule379 = \ _self -> + _self + +-- MaybeExpression --------------------------------------------- +-- wrapper +data Inh_MaybeExpression = Inh_MaybeExpression { opTable_Inh_MaybeExpression :: (OperatorTable), resolveErrors_Inh_MaybeExpression :: ( [ResolveError] ) } +data Syn_MaybeExpression = Syn_MaybeExpression { resolveErrors_Syn_MaybeExpression :: ( [ResolveError] ), self_Syn_MaybeExpression :: (MaybeExpression) } +{-# INLINABLE wrap_MaybeExpression #-} +wrap_MaybeExpression :: T_MaybeExpression -> Inh_MaybeExpression -> (Syn_MaybeExpression ) +wrap_MaybeExpression (T_MaybeExpression act) (Inh_MaybeExpression _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExpression_vIn94 _lhsIopTable _lhsIresolveErrors + (T_MaybeExpression_vOut94 _lhsOresolveErrors _lhsOself) <- return (inv_MaybeExpression_s95 sem arg) + return (Syn_MaybeExpression _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExpression #-} +sem_MaybeExpression :: MaybeExpression -> T_MaybeExpression +sem_MaybeExpression ( MaybeExpression_Nothing ) = sem_MaybeExpression_Nothing +sem_MaybeExpression ( MaybeExpression_Just expression_ ) = sem_MaybeExpression_Just ( sem_Expression expression_ ) + +-- semantic domain +newtype T_MaybeExpression = T_MaybeExpression { + attach_T_MaybeExpression :: Identity (T_MaybeExpression_s95 ) + } +newtype T_MaybeExpression_s95 = C_MaybeExpression_s95 { + inv_MaybeExpression_s95 :: (T_MaybeExpression_v94 ) + } +data T_MaybeExpression_s96 = C_MaybeExpression_s96 +type T_MaybeExpression_v94 = (T_MaybeExpression_vIn94 ) -> (T_MaybeExpression_vOut94 ) +data T_MaybeExpression_vIn94 = T_MaybeExpression_vIn94 (OperatorTable) ( [ResolveError] ) +data T_MaybeExpression_vOut94 = T_MaybeExpression_vOut94 ( [ResolveError] ) (MaybeExpression) +{-# NOINLINE sem_MaybeExpression_Nothing #-} +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule380 () + _lhsOself :: MaybeExpression + _lhsOself = rule381 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule382 _lhsIresolveErrors + __result_ = T_MaybeExpression_vOut94 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule380 #-} + rule380 = \ (_ :: ()) -> + MaybeExpression_Nothing + {-# INLINE rule381 #-} + rule381 = \ _self -> + _self + {-# INLINE rule382 #-} + rule382 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_MaybeExpression_Just #-} +sem_MaybeExpression_Just :: T_Expression -> T_MaybeExpression +sem_MaybeExpression_Just arg_expression_ = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 _lhsIopTable _lhsIresolveErrors) -> ( let + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule383 _expressionIself + _lhsOself :: MaybeExpression + _lhsOself = rule384 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule385 _expressionIresolveErrors + _expressionOopTable = rule386 _lhsIopTable + _expressionOresolveErrors = rule387 _lhsIresolveErrors + __result_ = T_MaybeExpression_vOut94 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule383 #-} + rule383 = \ ((_expressionIself) :: Expression) -> + MaybeExpression_Just _expressionIself + {-# INLINE rule384 #-} + rule384 = \ _self -> + _self + {-# INLINE rule385 #-} + rule385 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule386 #-} + rule386 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule387 #-} + rule387 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- MaybeImportSpecification ------------------------------------ +-- wrapper +data Inh_MaybeImportSpecification = Inh_MaybeImportSpecification { } +data Syn_MaybeImportSpecification = Syn_MaybeImportSpecification { self_Syn_MaybeImportSpecification :: (MaybeImportSpecification) } +{-# INLINABLE wrap_MaybeImportSpecification #-} +wrap_MaybeImportSpecification :: T_MaybeImportSpecification -> Inh_MaybeImportSpecification -> (Syn_MaybeImportSpecification ) +wrap_MaybeImportSpecification (T_MaybeImportSpecification act) (Inh_MaybeImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeImportSpecification_vIn97 + (T_MaybeImportSpecification_vOut97 _lhsOself) <- return (inv_MaybeImportSpecification_s98 sem arg) + return (Syn_MaybeImportSpecification _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeImportSpecification #-} +sem_MaybeImportSpecification :: MaybeImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification ( MaybeImportSpecification_Nothing ) = sem_MaybeImportSpecification_Nothing +sem_MaybeImportSpecification ( MaybeImportSpecification_Just importspecification_ ) = sem_MaybeImportSpecification_Just ( sem_ImportSpecification importspecification_ ) + +-- semantic domain +newtype T_MaybeImportSpecification = T_MaybeImportSpecification { + attach_T_MaybeImportSpecification :: Identity (T_MaybeImportSpecification_s98 ) + } +newtype T_MaybeImportSpecification_s98 = C_MaybeImportSpecification_s98 { + inv_MaybeImportSpecification_s98 :: (T_MaybeImportSpecification_v97 ) + } +data T_MaybeImportSpecification_s99 = C_MaybeImportSpecification_s99 +type T_MaybeImportSpecification_v97 = (T_MaybeImportSpecification_vIn97 ) -> (T_MaybeImportSpecification_vOut97 ) +data T_MaybeImportSpecification_vIn97 = T_MaybeImportSpecification_vIn97 +data T_MaybeImportSpecification_vOut97 = T_MaybeImportSpecification_vOut97 (MaybeImportSpecification) +{-# NOINLINE sem_MaybeImportSpecification_Nothing #-} +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _self = rule388 () + _lhsOself :: MaybeImportSpecification + _lhsOself = rule389 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule388 #-} + rule388 = \ (_ :: ()) -> + MaybeImportSpecification_Nothing + {-# INLINE rule389 #-} + rule389 = \ _self -> + _self +{-# NOINLINE sem_MaybeImportSpecification_Just #-} +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification_Just arg_importspecification_ = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _importspecificationX77 = Control.Monad.Identity.runIdentity (attach_T_ImportSpecification (arg_importspecification_)) + (T_ImportSpecification_vOut76 _importspecificationIself) = inv_ImportSpecification_s77 _importspecificationX77 (T_ImportSpecification_vIn76 ) + _self = rule390 _importspecificationIself + _lhsOself :: MaybeImportSpecification + _lhsOself = rule391 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule390 #-} + rule390 = \ ((_importspecificationIself) :: ImportSpecification) -> + MaybeImportSpecification_Just _importspecificationIself + {-# INLINE rule391 #-} + rule391 = \ _self -> + _self + +-- MaybeInt ---------------------------------------------------- +-- wrapper +data Inh_MaybeInt = Inh_MaybeInt { } +data Syn_MaybeInt = Syn_MaybeInt { self_Syn_MaybeInt :: (MaybeInt) } +{-# INLINABLE wrap_MaybeInt #-} +wrap_MaybeInt :: T_MaybeInt -> Inh_MaybeInt -> (Syn_MaybeInt ) +wrap_MaybeInt (T_MaybeInt act) (Inh_MaybeInt ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeInt_vIn100 + (T_MaybeInt_vOut100 _lhsOself) <- return (inv_MaybeInt_s101 sem arg) + return (Syn_MaybeInt _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeInt #-} +sem_MaybeInt :: MaybeInt -> T_MaybeInt +sem_MaybeInt ( MaybeInt_Nothing ) = sem_MaybeInt_Nothing +sem_MaybeInt ( MaybeInt_Just int_ ) = sem_MaybeInt_Just int_ + +-- semantic domain +newtype T_MaybeInt = T_MaybeInt { + attach_T_MaybeInt :: Identity (T_MaybeInt_s101 ) + } +newtype T_MaybeInt_s101 = C_MaybeInt_s101 { + inv_MaybeInt_s101 :: (T_MaybeInt_v100 ) + } +data T_MaybeInt_s102 = C_MaybeInt_s102 +type T_MaybeInt_v100 = (T_MaybeInt_vIn100 ) -> (T_MaybeInt_vOut100 ) +data T_MaybeInt_vIn100 = T_MaybeInt_vIn100 +data T_MaybeInt_vOut100 = T_MaybeInt_vOut100 (MaybeInt) +{-# NOINLINE sem_MaybeInt_Nothing #-} +sem_MaybeInt_Nothing :: T_MaybeInt +sem_MaybeInt_Nothing = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule392 () + _lhsOself :: MaybeInt + _lhsOself = rule393 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule392 #-} + rule392 = \ (_ :: ()) -> + MaybeInt_Nothing + {-# INLINE rule393 #-} + rule393 = \ _self -> + _self +{-# NOINLINE sem_MaybeInt_Just #-} +sem_MaybeInt_Just :: (Int) -> T_MaybeInt +sem_MaybeInt_Just arg_int_ = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule394 arg_int_ + _lhsOself :: MaybeInt + _lhsOself = rule395 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule394 #-} + rule394 = \ int_ -> + MaybeInt_Just int_ + {-# INLINE rule395 #-} + rule395 = \ _self -> + _self + +-- MaybeName --------------------------------------------------- +-- wrapper +data Inh_MaybeName = Inh_MaybeName { } +data Syn_MaybeName = Syn_MaybeName { self_Syn_MaybeName :: (MaybeName) } +{-# INLINABLE wrap_MaybeName #-} +wrap_MaybeName :: T_MaybeName -> Inh_MaybeName -> (Syn_MaybeName ) +wrap_MaybeName (T_MaybeName act) (Inh_MaybeName ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeName_vIn103 + (T_MaybeName_vOut103 _lhsOself) <- return (inv_MaybeName_s104 sem arg) + return (Syn_MaybeName _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeName #-} +sem_MaybeName :: MaybeName -> T_MaybeName +sem_MaybeName ( MaybeName_Nothing ) = sem_MaybeName_Nothing +sem_MaybeName ( MaybeName_Just name_ ) = sem_MaybeName_Just ( sem_Name name_ ) + +-- semantic domain +newtype T_MaybeName = T_MaybeName { + attach_T_MaybeName :: Identity (T_MaybeName_s104 ) + } +newtype T_MaybeName_s104 = C_MaybeName_s104 { + inv_MaybeName_s104 :: (T_MaybeName_v103 ) + } +data T_MaybeName_s105 = C_MaybeName_s105 +type T_MaybeName_v103 = (T_MaybeName_vIn103 ) -> (T_MaybeName_vOut103 ) +data T_MaybeName_vIn103 = T_MaybeName_vIn103 +data T_MaybeName_vOut103 = T_MaybeName_vOut103 (MaybeName) +{-# NOINLINE sem_MaybeName_Nothing #-} +sem_MaybeName_Nothing :: T_MaybeName +sem_MaybeName_Nothing = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _self = rule396 () + _lhsOself :: MaybeName + _lhsOself = rule397 _self + __result_ = T_MaybeName_vOut103 _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule396 #-} + rule396 = \ (_ :: ()) -> + MaybeName_Nothing + {-# INLINE rule397 #-} + rule397 = \ _self -> + _self +{-# NOINLINE sem_MaybeName_Just #-} +sem_MaybeName_Just :: T_Name -> T_MaybeName +sem_MaybeName_Just arg_name_ = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule398 _nameIself + _lhsOself :: MaybeName + _lhsOself = rule399 _self + __result_ = T_MaybeName_vOut103 _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule398 #-} + rule398 = \ ((_nameIself) :: Name) -> + MaybeName_Just _nameIself + {-# INLINE rule399 #-} + rule399 = \ _self -> + _self + +-- MaybeNames -------------------------------------------------- +-- wrapper +data Inh_MaybeNames = Inh_MaybeNames { } +data Syn_MaybeNames = Syn_MaybeNames { self_Syn_MaybeNames :: (MaybeNames) } +{-# INLINABLE wrap_MaybeNames #-} +wrap_MaybeNames :: T_MaybeNames -> Inh_MaybeNames -> (Syn_MaybeNames ) +wrap_MaybeNames (T_MaybeNames act) (Inh_MaybeNames ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeNames_vIn106 + (T_MaybeNames_vOut106 _lhsOself) <- return (inv_MaybeNames_s107 sem arg) + return (Syn_MaybeNames _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeNames #-} +sem_MaybeNames :: MaybeNames -> T_MaybeNames +sem_MaybeNames ( MaybeNames_Nothing ) = sem_MaybeNames_Nothing +sem_MaybeNames ( MaybeNames_Just names_ ) = sem_MaybeNames_Just ( sem_Names names_ ) + +-- semantic domain +newtype T_MaybeNames = T_MaybeNames { + attach_T_MaybeNames :: Identity (T_MaybeNames_s107 ) + } +newtype T_MaybeNames_s107 = C_MaybeNames_s107 { + inv_MaybeNames_s107 :: (T_MaybeNames_v106 ) + } +data T_MaybeNames_s108 = C_MaybeNames_s108 +type T_MaybeNames_v106 = (T_MaybeNames_vIn106 ) -> (T_MaybeNames_vOut106 ) +data T_MaybeNames_vIn106 = T_MaybeNames_vIn106 +data T_MaybeNames_vOut106 = T_MaybeNames_vOut106 (MaybeNames) +{-# NOINLINE sem_MaybeNames_Nothing #-} +sem_MaybeNames_Nothing :: T_MaybeNames +sem_MaybeNames_Nothing = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _self = rule400 () + _lhsOself :: MaybeNames + _lhsOself = rule401 _self + __result_ = T_MaybeNames_vOut106 _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule400 #-} + rule400 = \ (_ :: ()) -> + MaybeNames_Nothing + {-# INLINE rule401 #-} + rule401 = \ _self -> + _self +{-# NOINLINE sem_MaybeNames_Just #-} +sem_MaybeNames_Just :: T_Names -> T_MaybeNames +sem_MaybeNames_Just arg_names_ = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + _self = rule402 _namesIself + _lhsOself :: MaybeNames + _lhsOself = rule403 _self + __result_ = T_MaybeNames_vOut106 _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule402 #-} + rule402 = \ ((_namesIself) :: Names) -> + MaybeNames_Just _namesIself + {-# INLINE rule403 #-} + rule403 = \ _self -> + _self + +-- Module ------------------------------------------------------ +-- wrapper +data Inh_Module = Inh_Module { opTable_Inh_Module :: (OperatorTable), resolveErrors_Inh_Module :: ( [ResolveError] ) } +data Syn_Module = Syn_Module { resolveErrors_Syn_Module :: ( [ResolveError] ), self_Syn_Module :: (Module) } +{-# INLINABLE wrap_Module #-} +wrap_Module :: T_Module -> Inh_Module -> (Syn_Module ) +wrap_Module (T_Module act) (Inh_Module _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Module_vIn109 _lhsIopTable _lhsIresolveErrors + (T_Module_vOut109 _lhsOresolveErrors _lhsOself) <- return (inv_Module_s110 sem arg) + return (Syn_Module _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# INLINE sem_Module #-} +sem_Module :: Module -> T_Module +sem_Module ( Module_Module range_ name_ exports_ body_ ) = sem_Module_Module ( sem_Range range_ ) ( sem_MaybeName name_ ) ( sem_MaybeExports exports_ ) ( sem_Body body_ ) + +-- semantic domain +newtype T_Module = T_Module { + attach_T_Module :: Identity (T_Module_s110 ) + } +newtype T_Module_s110 = C_Module_s110 { + inv_Module_s110 :: (T_Module_v109 ) + } +data T_Module_s111 = C_Module_s111 +type T_Module_v109 = (T_Module_vIn109 ) -> (T_Module_vOut109 ) +data T_Module_vIn109 = T_Module_vIn109 (OperatorTable) ( [ResolveError] ) +data T_Module_vOut109 = T_Module_vOut109 ( [ResolveError] ) (Module) +{-# NOINLINE sem_Module_Module #-} +sem_Module_Module :: T_Range -> T_MaybeName -> T_MaybeExports -> T_Body -> T_Module +sem_Module_Module arg_range_ arg_name_ arg_exports_ arg_body_ = T_Module (return st110) where + {-# NOINLINE st110 #-} + st110 = let + v109 :: T_Module_v109 + v109 = \ (T_Module_vIn109 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_name_)) + _exportsX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeExports (arg_exports_)) + _bodyX14 = Control.Monad.Identity.runIdentity (attach_T_Body (arg_body_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeName_vOut103 _nameIself) = inv_MaybeName_s104 _nameX104 (T_MaybeName_vIn103 ) + (T_MaybeExports_vOut91 _exportsIself) = inv_MaybeExports_s92 _exportsX92 (T_MaybeExports_vIn91 ) + (T_Body_vOut13 _bodyIresolveErrors _bodyIself) = inv_Body_s14 _bodyX14 (T_Body_vIn13 _bodyOopTable _bodyOresolveErrors) + _self = rule404 _bodyIself _exportsIself _nameIself _rangeIself + _lhsOself :: Module + _lhsOself = rule405 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule406 _bodyIresolveErrors + _bodyOopTable = rule407 _lhsIopTable + _bodyOresolveErrors = rule408 _lhsIresolveErrors + __result_ = T_Module_vOut109 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Module_s110 v109 + {-# INLINE rule404 #-} + rule404 = \ ((_bodyIself) :: Body) ((_exportsIself) :: MaybeExports) ((_nameIself) :: MaybeName) ((_rangeIself) :: Range) -> + Module_Module _rangeIself _nameIself _exportsIself _bodyIself + {-# INLINE rule405 #-} + rule405 = \ _self -> + _self + {-# INLINE rule406 #-} + rule406 = \ ((_bodyIresolveErrors) :: [ResolveError] ) -> + _bodyIresolveErrors + {-# INLINE rule407 #-} + rule407 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule408 #-} + rule408 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Name -------------------------------------------------------- +-- wrapper +data Inh_Name = Inh_Name { } +data Syn_Name = Syn_Name { self_Syn_Name :: (Name) } +{-# INLINABLE wrap_Name #-} +wrap_Name :: T_Name -> Inh_Name -> (Syn_Name ) +wrap_Name (T_Name act) (Inh_Name ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Name_vIn112 + (T_Name_vOut112 _lhsOself) <- return (inv_Name_s113 sem arg) + return (Syn_Name _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Name #-} +sem_Name :: Name -> T_Name +sem_Name ( Name_Identifier range_ module_ name_ ) = sem_Name_Identifier ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Operator range_ module_ name_ ) = sem_Name_Operator ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Special range_ module_ name_ ) = sem_Name_Special ( sem_Range range_ ) ( sem_Strings module_ ) name_ + +-- semantic domain +newtype T_Name = T_Name { + attach_T_Name :: Identity (T_Name_s113 ) + } +newtype T_Name_s113 = C_Name_s113 { + inv_Name_s113 :: (T_Name_v112 ) + } +data T_Name_s114 = C_Name_s114 +type T_Name_v112 = (T_Name_vIn112 ) -> (T_Name_vOut112 ) +data T_Name_vIn112 = T_Name_vIn112 +data T_Name_vOut112 = T_Name_vOut112 (Name) +{-# NOINLINE sem_Name_Identifier #-} +sem_Name_Identifier :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Identifier arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule409 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule410 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule409 #-} + rule409 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Identifier _rangeIself _moduleIself name_ + {-# INLINE rule410 #-} + rule410 = \ _self -> + _self +{-# NOINLINE sem_Name_Operator #-} +sem_Name_Operator :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Operator arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule411 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule412 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule411 #-} + rule411 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Operator _rangeIself _moduleIself name_ + {-# INLINE rule412 #-} + rule412 = \ _self -> + _self +{-# NOINLINE sem_Name_Special #-} +sem_Name_Special :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Special arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule413 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule414 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule413 #-} + rule413 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Special _rangeIself _moduleIself name_ + {-# INLINE rule414 #-} + rule414 = \ _self -> + _self + +-- Names ------------------------------------------------------- +-- wrapper +data Inh_Names = Inh_Names { } +data Syn_Names = Syn_Names { self_Syn_Names :: (Names) } +{-# INLINABLE wrap_Names #-} +wrap_Names :: T_Names -> Inh_Names -> (Syn_Names ) +wrap_Names (T_Names act) (Inh_Names ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Names_vIn115 + (T_Names_vOut115 _lhsOself) <- return (inv_Names_s116 sem arg) + return (Syn_Names _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Names #-} +sem_Names :: Names -> T_Names +sem_Names list = Prelude.foldr sem_Names_Cons sem_Names_Nil (Prelude.map sem_Name list) + +-- semantic domain +newtype T_Names = T_Names { + attach_T_Names :: Identity (T_Names_s116 ) + } +newtype T_Names_s116 = C_Names_s116 { + inv_Names_s116 :: (T_Names_v115 ) + } +data T_Names_s117 = C_Names_s117 +type T_Names_v115 = (T_Names_vIn115 ) -> (T_Names_vOut115 ) +data T_Names_vIn115 = T_Names_vIn115 +data T_Names_vOut115 = T_Names_vOut115 (Names) +{-# NOINLINE sem_Names_Cons #-} +sem_Names_Cons :: T_Name -> T_Names -> T_Names +sem_Names_Cons arg_hd_ arg_tl_ = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _hdX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_hd_)) + _tlX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_tl_)) + (T_Name_vOut112 _hdIself) = inv_Name_s113 _hdX113 (T_Name_vIn112 ) + (T_Names_vOut115 _tlIself) = inv_Names_s116 _tlX116 (T_Names_vIn115 ) + _self = rule415 _hdIself _tlIself + _lhsOself :: Names + _lhsOself = rule416 _self + __result_ = T_Names_vOut115 _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule415 #-} + rule415 = \ ((_hdIself) :: Name) ((_tlIself) :: Names) -> + (:) _hdIself _tlIself + {-# INLINE rule416 #-} + rule416 = \ _self -> + _self +{-# NOINLINE sem_Names_Nil #-} +sem_Names_Nil :: T_Names +sem_Names_Nil = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _self = rule417 () + _lhsOself :: Names + _lhsOself = rule418 _self + __result_ = T_Names_vOut115 _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule417 #-} + rule417 = \ (_ :: ()) -> + [] + {-# INLINE rule418 #-} + rule418 = \ _self -> + _self + +-- Pattern ----------------------------------------------------- +-- wrapper +data Inh_Pattern = Inh_Pattern { opTable_Inh_Pattern :: (OperatorTable), resolveErrors_Inh_Pattern :: ( [ResolveError] ) } +data Syn_Pattern = Syn_Pattern { resolveErrors_Syn_Pattern :: ( [ResolveError] ), self_Syn_Pattern :: (Pattern) } +{-# INLINABLE wrap_Pattern #-} +wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) +wrap_Pattern (T_Pattern act) (Inh_Pattern _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors + (T_Pattern_vOut118 _lhsOresolveErrors _lhsOself) <- return (inv_Pattern_s119 sem arg) + return (Syn_Pattern _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Pattern #-} +sem_Pattern :: Pattern -> T_Pattern +sem_Pattern ( Pattern_Hole range_ id_ ) = sem_Pattern_Hole ( sem_Range range_ ) id_ +sem_Pattern ( Pattern_Literal range_ literal_ ) = sem_Pattern_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_Variable range_ name_ ) = sem_Pattern_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Pattern ( Pattern_Constructor range_ name_ patterns_ ) = sem_Pattern_Constructor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Parenthesized range_ pattern_ ) = sem_Pattern_Parenthesized ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ ) = sem_Pattern_InfixConstructor ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name constructorOperator_ ) ( sem_Pattern rightPattern_ ) +sem_Pattern ( Pattern_List range_ patterns_ ) = sem_Pattern_List ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Tuple range_ patterns_ ) = sem_Pattern_Tuple ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Record range_ name_ recordPatternBindings_ ) = sem_Pattern_Record ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordPatternBindings recordPatternBindings_ ) +sem_Pattern ( Pattern_Negate range_ literal_ ) = sem_Pattern_Negate ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_As range_ name_ pattern_ ) = sem_Pattern_As ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Wildcard range_ ) = sem_Pattern_Wildcard ( sem_Range range_ ) +sem_Pattern ( Pattern_Irrefutable range_ pattern_ ) = sem_Pattern_Irrefutable ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Successor range_ name_ literal_ ) = sem_Pattern_Successor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_NegateFloat range_ literal_ ) = sem_Pattern_NegateFloat ( sem_Range range_ ) ( sem_Literal literal_ ) + +-- semantic domain +newtype T_Pattern = T_Pattern { + attach_T_Pattern :: Identity (T_Pattern_s119 ) + } +newtype T_Pattern_s119 = C_Pattern_s119 { + inv_Pattern_s119 :: (T_Pattern_v118 ) + } +data T_Pattern_s120 = C_Pattern_s120 +type T_Pattern_v118 = (T_Pattern_vIn118 ) -> (T_Pattern_vOut118 ) +data T_Pattern_vIn118 = T_Pattern_vIn118 (OperatorTable) ( [ResolveError] ) +data T_Pattern_vOut118 = T_Pattern_vOut118 ( [ResolveError] ) (Pattern) +{-# NOINLINE sem_Pattern_Hole #-} +sem_Pattern_Hole :: T_Range -> (Integer) -> T_Pattern +sem_Pattern_Hole arg_range_ arg_id_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule419 _rangeIself arg_id_ + _lhsOself :: Pattern + _lhsOself = rule420 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule421 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule419 #-} + rule419 = \ ((_rangeIself) :: Range) id_ -> + Pattern_Hole _rangeIself id_ + {-# INLINE rule420 #-} + rule420 = \ _self -> + _self + {-# INLINE rule421 #-} + rule421 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_Literal #-} +sem_Pattern_Literal :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Literal arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule422 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule423 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule424 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule422 #-} + rule422 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Literal _rangeIself _literalIself + {-# INLINE rule423 #-} + rule423 = \ _self -> + _self + {-# INLINE rule424 #-} + rule424 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_Variable #-} +sem_Pattern_Variable :: T_Range -> T_Name -> T_Pattern +sem_Pattern_Variable arg_range_ arg_name_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule425 _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule426 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule427 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule425 #-} + rule425 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Variable _rangeIself _nameIself + {-# INLINE rule426 #-} + rule426 = \ _self -> + _self + {-# INLINE rule427 #-} + rule427 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_Constructor #-} +sem_Pattern_Constructor :: T_Range -> T_Name -> T_Patterns -> T_Pattern +sem_Pattern_Constructor arg_range_ arg_name_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIresolveErrors _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOopTable _patternsOresolveErrors) + _self = rule428 _nameIself _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule429 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule430 _patternsIresolveErrors + _patternsOopTable = rule431 _lhsIopTable + _patternsOresolveErrors = rule432 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule428 #-} + rule428 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Constructor _rangeIself _nameIself _patternsIself + {-# INLINE rule429 #-} + rule429 = \ _self -> + _self + {-# INLINE rule430 #-} + rule430 = \ ((_patternsIresolveErrors) :: [ResolveError] ) -> + _patternsIresolveErrors + {-# INLINE rule431 #-} + rule431 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule432 #-} + rule432 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_Parenthesized #-} +sem_Pattern_Parenthesized :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Parenthesized arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIresolveErrors _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOopTable _patternOresolveErrors) + _self = rule433 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule434 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule435 _patternIresolveErrors + _patternOopTable = rule436 _lhsIopTable + _patternOresolveErrors = rule437 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule433 #-} + rule433 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Parenthesized _rangeIself _patternIself + {-# INLINE rule434 #-} + rule434 = \ _self -> + _self + {-# INLINE rule435 #-} + rule435 = \ ((_patternIresolveErrors) :: [ResolveError] ) -> + _patternIresolveErrors + {-# INLINE rule436 #-} + rule436 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule437 #-} + rule437 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_InfixConstructor #-} +sem_Pattern_InfixConstructor :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_InfixConstructor arg_range_ arg_leftPattern_ arg_constructorOperator_ arg_rightPattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIresolveErrors _leftPatternIself) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 _leftPatternOopTable _leftPatternOresolveErrors) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIresolveErrors _rightPatternIself) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 _rightPatternOopTable _rightPatternOresolveErrors) + _self = rule438 _constructorOperatorIself _leftPatternIself _rangeIself _rightPatternIself + _lhsOself :: Pattern + _lhsOself = rule439 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule440 _rightPatternIresolveErrors + _leftPatternOopTable = rule441 _lhsIopTable + _leftPatternOresolveErrors = rule442 _lhsIresolveErrors + _rightPatternOopTable = rule443 _lhsIopTable + _rightPatternOresolveErrors = rule444 _leftPatternIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule438 #-} + rule438 = \ ((_constructorOperatorIself) :: Name) ((_leftPatternIself) :: Pattern) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + Pattern_InfixConstructor _rangeIself _leftPatternIself _constructorOperatorIself _rightPatternIself + {-# INLINE rule439 #-} + rule439 = \ _self -> + _self + {-# INLINE rule440 #-} + rule440 = \ ((_rightPatternIresolveErrors) :: [ResolveError] ) -> + _rightPatternIresolveErrors + {-# INLINE rule441 #-} + rule441 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule442 #-} + rule442 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule443 #-} + rule443 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule444 #-} + rule444 = \ ((_leftPatternIresolveErrors) :: [ResolveError] ) -> + _leftPatternIresolveErrors +{-# NOINLINE sem_Pattern_List #-} +sem_Pattern_List :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_List arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIresolveErrors _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOopTable _patternsOresolveErrors) + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule445 _errs _patternsIresolveErrors + (_self,_errs) = rule446 _lhsIopTable _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule447 _self + _patternsOopTable = rule448 _lhsIopTable + _patternsOresolveErrors = rule449 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule445 #-} + rule445 = \ _errs ((_patternsIresolveErrors) :: [ResolveError] ) -> + _errs ++ _patternsIresolveErrors + {-# INLINE rule446 #-} + rule446 = \ ((_lhsIopTable) :: OperatorTable) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + case _rangeIself of + Range_Range Position_Unknown Position_Unknown -> + resolvePattern _lhsIopTable _patternsIself + _ -> + (Pattern_List _rangeIself _patternsIself, []) + {-# INLINE rule447 #-} + rule447 = \ _self -> + _self + {-# INLINE rule448 #-} + rule448 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule449 #-} + rule449 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_Tuple #-} +sem_Pattern_Tuple :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_Tuple arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIresolveErrors _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOopTable _patternsOresolveErrors) + _self = rule450 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule451 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule452 _patternsIresolveErrors + _patternsOopTable = rule453 _lhsIopTable + _patternsOresolveErrors = rule454 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule450 #-} + rule450 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Tuple _rangeIself _patternsIself + {-# INLINE rule451 #-} + rule451 = \ _self -> + _self + {-# INLINE rule452 #-} + rule452 = \ ((_patternsIresolveErrors) :: [ResolveError] ) -> + _patternsIresolveErrors + {-# INLINE rule453 #-} + rule453 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule454 #-} + rule454 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_Record #-} +sem_Pattern_Record :: T_Range -> T_Name -> T_RecordPatternBindings -> T_Pattern +sem_Pattern_Record arg_range_ arg_name_ arg_recordPatternBindings_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordPatternBindingsX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_recordPatternBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordPatternBindings_vOut145 _recordPatternBindingsIresolveErrors _recordPatternBindingsIself) = inv_RecordPatternBindings_s146 _recordPatternBindingsX146 (T_RecordPatternBindings_vIn145 _recordPatternBindingsOopTable _recordPatternBindingsOresolveErrors) + _self = rule455 _nameIself _rangeIself _recordPatternBindingsIself + _lhsOself :: Pattern + _lhsOself = rule456 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule457 _recordPatternBindingsIresolveErrors + _recordPatternBindingsOopTable = rule458 _lhsIopTable + _recordPatternBindingsOresolveErrors = rule459 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule455 #-} + rule455 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordPatternBindingsIself) :: RecordPatternBindings) -> + Pattern_Record _rangeIself _nameIself _recordPatternBindingsIself + {-# INLINE rule456 #-} + rule456 = \ _self -> + _self + {-# INLINE rule457 #-} + rule457 = \ ((_recordPatternBindingsIresolveErrors) :: [ResolveError] ) -> + _recordPatternBindingsIresolveErrors + {-# INLINE rule458 #-} + rule458 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule459 #-} + rule459 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_Negate #-} +sem_Pattern_Negate :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Negate arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule460 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule461 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule462 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule460 #-} + rule460 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Negate _rangeIself _literalIself + {-# INLINE rule461 #-} + rule461 = \ _self -> + _self + {-# INLINE rule462 #-} + rule462 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_As #-} +sem_Pattern_As :: T_Range -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_As arg_range_ arg_name_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIresolveErrors _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOopTable _patternOresolveErrors) + _self = rule463 _nameIself _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule464 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule465 _patternIresolveErrors + _patternOopTable = rule466 _lhsIopTable + _patternOresolveErrors = rule467 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule463 #-} + rule463 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_As _rangeIself _nameIself _patternIself + {-# INLINE rule464 #-} + rule464 = \ _self -> + _self + {-# INLINE rule465 #-} + rule465 = \ ((_patternIresolveErrors) :: [ResolveError] ) -> + _patternIresolveErrors + {-# INLINE rule466 #-} + rule466 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule467 #-} + rule467 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_Wildcard #-} +sem_Pattern_Wildcard :: T_Range -> T_Pattern +sem_Pattern_Wildcard arg_range_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule468 _rangeIself + _lhsOself :: Pattern + _lhsOself = rule469 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule470 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule468 #-} + rule468 = \ ((_rangeIself) :: Range) -> + Pattern_Wildcard _rangeIself + {-# INLINE rule469 #-} + rule469 = \ _self -> + _self + {-# INLINE rule470 #-} + rule470 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_Irrefutable #-} +sem_Pattern_Irrefutable :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Irrefutable arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIresolveErrors _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOopTable _patternOresolveErrors) + _self = rule471 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule472 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule473 _patternIresolveErrors + _patternOopTable = rule474 _lhsIopTable + _patternOresolveErrors = rule475 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule471 #-} + rule471 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Irrefutable _rangeIself _patternIself + {-# INLINE rule472 #-} + rule472 = \ _self -> + _self + {-# INLINE rule473 #-} + rule473 = \ ((_patternIresolveErrors) :: [ResolveError] ) -> + _patternIresolveErrors + {-# INLINE rule474 #-} + rule474 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule475 #-} + rule475 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_Successor #-} +sem_Pattern_Successor :: T_Range -> T_Name -> T_Literal -> T_Pattern +sem_Pattern_Successor arg_range_ arg_name_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule476 _literalIself _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule477 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule478 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule476 #-} + rule476 = \ ((_literalIself) :: Literal) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Successor _rangeIself _nameIself _literalIself + {-# INLINE rule477 #-} + rule477 = \ _self -> + _self + {-# INLINE rule478 #-} + rule478 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Pattern_NegateFloat #-} +sem_Pattern_NegateFloat :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_NegateFloat arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule479 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule480 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule481 _lhsIresolveErrors + __result_ = T_Pattern_vOut118 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule479 #-} + rule479 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_NegateFloat _rangeIself _literalIself + {-# INLINE rule480 #-} + rule480 = \ _self -> + _self + {-# INLINE rule481 #-} + rule481 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Patterns ---------------------------------------------------- +-- wrapper +data Inh_Patterns = Inh_Patterns { opTable_Inh_Patterns :: (OperatorTable), resolveErrors_Inh_Patterns :: ( [ResolveError] ) } +data Syn_Patterns = Syn_Patterns { resolveErrors_Syn_Patterns :: ( [ResolveError] ), self_Syn_Patterns :: (Patterns) } +{-# INLINABLE wrap_Patterns #-} +wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) +wrap_Patterns (T_Patterns act) (Inh_Patterns _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Patterns_vIn121 _lhsIopTable _lhsIresolveErrors + (T_Patterns_vOut121 _lhsOresolveErrors _lhsOself) <- return (inv_Patterns_s122 sem arg) + return (Syn_Patterns _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Patterns #-} +sem_Patterns :: Patterns -> T_Patterns +sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) + +-- semantic domain +newtype T_Patterns = T_Patterns { + attach_T_Patterns :: Identity (T_Patterns_s122 ) + } +newtype T_Patterns_s122 = C_Patterns_s122 { + inv_Patterns_s122 :: (T_Patterns_v121 ) + } +data T_Patterns_s123 = C_Patterns_s123 +type T_Patterns_v121 = (T_Patterns_vIn121 ) -> (T_Patterns_vOut121 ) +data T_Patterns_vIn121 = T_Patterns_vIn121 (OperatorTable) ( [ResolveError] ) +data T_Patterns_vOut121 = T_Patterns_vOut121 ( [ResolveError] ) (Patterns) +{-# NOINLINE sem_Patterns_Cons #-} +sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns +sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 _lhsIopTable _lhsIresolveErrors) -> ( let + _hdX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) + _tlX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) + (T_Pattern_vOut118 _hdIresolveErrors _hdIself) = inv_Pattern_s119 _hdX119 (T_Pattern_vIn118 _hdOopTable _hdOresolveErrors) + (T_Patterns_vOut121 _tlIresolveErrors _tlIself) = inv_Patterns_s122 _tlX122 (T_Patterns_vIn121 _tlOopTable _tlOresolveErrors) + _self = rule482 _hdIself _tlIself + _lhsOself :: Patterns + _lhsOself = rule483 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule484 _tlIresolveErrors + _hdOopTable = rule485 _lhsIopTable + _hdOresolveErrors = rule486 _lhsIresolveErrors + _tlOopTable = rule487 _lhsIopTable + _tlOresolveErrors = rule488 _hdIresolveErrors + __result_ = T_Patterns_vOut121 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule482 #-} + rule482 = \ ((_hdIself) :: Pattern) ((_tlIself) :: Patterns) -> + (:) _hdIself _tlIself + {-# INLINE rule483 #-} + rule483 = \ _self -> + _self + {-# INLINE rule484 #-} + rule484 = \ ((_tlIresolveErrors) :: [ResolveError] ) -> + _tlIresolveErrors + {-# INLINE rule485 #-} + rule485 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule486 #-} + rule486 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule487 #-} + rule487 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule488 #-} + rule488 = \ ((_hdIresolveErrors) :: [ResolveError] ) -> + _hdIresolveErrors +{-# NOINLINE sem_Patterns_Nil #-} +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule489 () + _lhsOself :: Patterns + _lhsOself = rule490 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule491 _lhsIresolveErrors + __result_ = T_Patterns_vOut121 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule489 #-} + rule489 = \ (_ :: ()) -> + [] + {-# INLINE rule490 #-} + rule490 = \ _self -> + _self + {-# INLINE rule491 #-} + rule491 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Position ---------------------------------------------------- +-- wrapper +data Inh_Position = Inh_Position { } +data Syn_Position = Syn_Position { self_Syn_Position :: (Position) } +{-# INLINABLE wrap_Position #-} +wrap_Position :: T_Position -> Inh_Position -> (Syn_Position ) +wrap_Position (T_Position act) (Inh_Position ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Position_vIn124 + (T_Position_vOut124 _lhsOself) <- return (inv_Position_s125 sem arg) + return (Syn_Position _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Position #-} +sem_Position :: Position -> T_Position +sem_Position ( Position_Position filename_ line_ column_ ) = sem_Position_Position filename_ line_ column_ +sem_Position ( Position_Unknown ) = sem_Position_Unknown + +-- semantic domain +newtype T_Position = T_Position { + attach_T_Position :: Identity (T_Position_s125 ) + } +newtype T_Position_s125 = C_Position_s125 { + inv_Position_s125 :: (T_Position_v124 ) + } +data T_Position_s126 = C_Position_s126 +type T_Position_v124 = (T_Position_vIn124 ) -> (T_Position_vOut124 ) +data T_Position_vIn124 = T_Position_vIn124 +data T_Position_vOut124 = T_Position_vOut124 (Position) +{-# NOINLINE sem_Position_Position #-} +sem_Position_Position :: (String) -> (Int) -> (Int) -> T_Position +sem_Position_Position arg_filename_ arg_line_ arg_column_ = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule492 arg_column_ arg_filename_ arg_line_ + _lhsOself :: Position + _lhsOself = rule493 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule492 #-} + rule492 = \ column_ filename_ line_ -> + Position_Position filename_ line_ column_ + {-# INLINE rule493 #-} + rule493 = \ _self -> + _self +{-# NOINLINE sem_Position_Unknown #-} +sem_Position_Unknown :: T_Position +sem_Position_Unknown = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule494 () + _lhsOself :: Position + _lhsOself = rule495 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule494 #-} + rule494 = \ (_ :: ()) -> + Position_Unknown + {-# INLINE rule495 #-} + rule495 = \ _self -> + _self + +-- Qualifier --------------------------------------------------- +-- wrapper +data Inh_Qualifier = Inh_Qualifier { opTable_Inh_Qualifier :: (OperatorTable), resolveErrors_Inh_Qualifier :: ( [ResolveError] ) } +data Syn_Qualifier = Syn_Qualifier { resolveErrors_Syn_Qualifier :: ( [ResolveError] ), self_Syn_Qualifier :: (Qualifier) } +{-# INLINABLE wrap_Qualifier #-} +wrap_Qualifier :: T_Qualifier -> Inh_Qualifier -> (Syn_Qualifier ) +wrap_Qualifier (T_Qualifier act) (Inh_Qualifier _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifier_vIn127 _lhsIopTable _lhsIresolveErrors + (T_Qualifier_vOut127 _lhsOresolveErrors _lhsOself) <- return (inv_Qualifier_s128 sem arg) + return (Syn_Qualifier _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifier #-} +sem_Qualifier :: Qualifier -> T_Qualifier +sem_Qualifier ( Qualifier_Guard range_ guard_ ) = sem_Qualifier_Guard ( sem_Range range_ ) ( sem_Expression guard_ ) +sem_Qualifier ( Qualifier_Let range_ declarations_ ) = sem_Qualifier_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Qualifier ( Qualifier_Generator range_ pattern_ expression_ ) = sem_Qualifier_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Qualifier ( Qualifier_Empty range_ ) = sem_Qualifier_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Qualifier = T_Qualifier { + attach_T_Qualifier :: Identity (T_Qualifier_s128 ) + } +newtype T_Qualifier_s128 = C_Qualifier_s128 { + inv_Qualifier_s128 :: (T_Qualifier_v127 ) + } +data T_Qualifier_s129 = C_Qualifier_s129 +type T_Qualifier_v127 = (T_Qualifier_vIn127 ) -> (T_Qualifier_vOut127 ) +data T_Qualifier_vIn127 = T_Qualifier_vIn127 (OperatorTable) ( [ResolveError] ) +data T_Qualifier_vOut127 = T_Qualifier_vOut127 ( [ResolveError] ) (Qualifier) +{-# NOINLINE sem_Qualifier_Guard #-} +sem_Qualifier_Guard :: T_Range -> T_Expression -> T_Qualifier +sem_Qualifier_Guard arg_range_ arg_guard_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIresolveErrors _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 _guardOopTable _guardOresolveErrors) + _self = rule496 _guardIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule497 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule498 _guardIresolveErrors + _guardOopTable = rule499 _lhsIopTable + _guardOresolveErrors = rule500 _lhsIresolveErrors + __result_ = T_Qualifier_vOut127 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule496 #-} + rule496 = \ ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + Qualifier_Guard _rangeIself _guardIself + {-# INLINE rule497 #-} + rule497 = \ _self -> + _self + {-# INLINE rule498 #-} + rule498 = \ ((_guardIresolveErrors) :: [ResolveError] ) -> + _guardIresolveErrors + {-# INLINE rule499 #-} + rule499 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule500 #-} + rule500 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Qualifier_Let #-} +sem_Qualifier_Let :: T_Range -> T_Declarations -> T_Qualifier +sem_Qualifier_Let arg_range_ arg_declarations_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIresolveErrors _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOopTable _declarationsOresolveErrors) + _self = rule501 _declarationsIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule502 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule503 _declarationsIresolveErrors + _declarationsOopTable = rule504 _lhsIopTable + _declarationsOresolveErrors = rule505 _lhsIresolveErrors + __result_ = T_Qualifier_vOut127 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule501 #-} + rule501 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Qualifier_Let _rangeIself _declarationsIself + {-# INLINE rule502 #-} + rule502 = \ _self -> + _self + {-# INLINE rule503 #-} + rule503 = \ ((_declarationsIresolveErrors) :: [ResolveError] ) -> + _declarationsIresolveErrors + {-# INLINE rule504 #-} + rule504 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule505 #-} + rule505 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Qualifier_Generator #-} +sem_Qualifier_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Qualifier +sem_Qualifier_Generator arg_range_ arg_pattern_ arg_expression_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIresolveErrors _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOopTable _patternOresolveErrors) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule506 _expressionIself _patternIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule507 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule508 _expressionIresolveErrors + _patternOopTable = rule509 _lhsIopTable + _patternOresolveErrors = rule510 _lhsIresolveErrors + _expressionOopTable = rule511 _lhsIopTable + _expressionOresolveErrors = rule512 _patternIresolveErrors + __result_ = T_Qualifier_vOut127 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule506 #-} + rule506 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Qualifier_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule507 #-} + rule507 = \ _self -> + _self + {-# INLINE rule508 #-} + rule508 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule509 #-} + rule509 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule510 #-} + rule510 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule511 #-} + rule511 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule512 #-} + rule512 = \ ((_patternIresolveErrors) :: [ResolveError] ) -> + _patternIresolveErrors +{-# NOINLINE sem_Qualifier_Empty #-} +sem_Qualifier_Empty :: T_Range -> T_Qualifier +sem_Qualifier_Empty arg_range_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule513 _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule514 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule515 _lhsIresolveErrors + __result_ = T_Qualifier_vOut127 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule513 #-} + rule513 = \ ((_rangeIself) :: Range) -> + Qualifier_Empty _rangeIself + {-# INLINE rule514 #-} + rule514 = \ _self -> + _self + {-# INLINE rule515 #-} + rule515 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Qualifiers -------------------------------------------------- +-- wrapper +data Inh_Qualifiers = Inh_Qualifiers { opTable_Inh_Qualifiers :: (OperatorTable), resolveErrors_Inh_Qualifiers :: ( [ResolveError] ) } +data Syn_Qualifiers = Syn_Qualifiers { resolveErrors_Syn_Qualifiers :: ( [ResolveError] ), self_Syn_Qualifiers :: (Qualifiers) } +{-# INLINABLE wrap_Qualifiers #-} +wrap_Qualifiers :: T_Qualifiers -> Inh_Qualifiers -> (Syn_Qualifiers ) +wrap_Qualifiers (T_Qualifiers act) (Inh_Qualifiers _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifiers_vIn130 _lhsIopTable _lhsIresolveErrors + (T_Qualifiers_vOut130 _lhsOresolveErrors _lhsOself) <- return (inv_Qualifiers_s131 sem arg) + return (Syn_Qualifiers _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifiers #-} +sem_Qualifiers :: Qualifiers -> T_Qualifiers +sem_Qualifiers list = Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list) + +-- semantic domain +newtype T_Qualifiers = T_Qualifiers { + attach_T_Qualifiers :: Identity (T_Qualifiers_s131 ) + } +newtype T_Qualifiers_s131 = C_Qualifiers_s131 { + inv_Qualifiers_s131 :: (T_Qualifiers_v130 ) + } +data T_Qualifiers_s132 = C_Qualifiers_s132 +type T_Qualifiers_v130 = (T_Qualifiers_vIn130 ) -> (T_Qualifiers_vOut130 ) +data T_Qualifiers_vIn130 = T_Qualifiers_vIn130 (OperatorTable) ( [ResolveError] ) +data T_Qualifiers_vOut130 = T_Qualifiers_vOut130 ( [ResolveError] ) (Qualifiers) +{-# NOINLINE sem_Qualifiers_Cons #-} +sem_Qualifiers_Cons :: T_Qualifier -> T_Qualifiers -> T_Qualifiers +sem_Qualifiers_Cons arg_hd_ arg_tl_ = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 _lhsIopTable _lhsIresolveErrors) -> ( let + _hdX128 = Control.Monad.Identity.runIdentity (attach_T_Qualifier (arg_hd_)) + _tlX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_tl_)) + (T_Qualifier_vOut127 _hdIresolveErrors _hdIself) = inv_Qualifier_s128 _hdX128 (T_Qualifier_vIn127 _hdOopTable _hdOresolveErrors) + (T_Qualifiers_vOut130 _tlIresolveErrors _tlIself) = inv_Qualifiers_s131 _tlX131 (T_Qualifiers_vIn130 _tlOopTable _tlOresolveErrors) + _self = rule516 _hdIself _tlIself + _lhsOself :: Qualifiers + _lhsOself = rule517 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule518 _tlIresolveErrors + _hdOopTable = rule519 _lhsIopTable + _hdOresolveErrors = rule520 _lhsIresolveErrors + _tlOopTable = rule521 _lhsIopTable + _tlOresolveErrors = rule522 _hdIresolveErrors + __result_ = T_Qualifiers_vOut130 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule516 #-} + rule516 = \ ((_hdIself) :: Qualifier) ((_tlIself) :: Qualifiers) -> + (:) _hdIself _tlIself + {-# INLINE rule517 #-} + rule517 = \ _self -> + _self + {-# INLINE rule518 #-} + rule518 = \ ((_tlIresolveErrors) :: [ResolveError] ) -> + _tlIresolveErrors + {-# INLINE rule519 #-} + rule519 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule520 #-} + rule520 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule521 #-} + rule521 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule522 #-} + rule522 = \ ((_hdIresolveErrors) :: [ResolveError] ) -> + _hdIresolveErrors +{-# NOINLINE sem_Qualifiers_Nil #-} +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule523 () + _lhsOself :: Qualifiers + _lhsOself = rule524 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule525 _lhsIresolveErrors + __result_ = T_Qualifiers_vOut130 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule523 #-} + rule523 = \ (_ :: ()) -> + [] + {-# INLINE rule524 #-} + rule524 = \ _self -> + _self + {-# INLINE rule525 #-} + rule525 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Range ------------------------------------------------------- +-- wrapper +data Inh_Range = Inh_Range { } +data Syn_Range = Syn_Range { self_Syn_Range :: (Range) } +{-# INLINABLE wrap_Range #-} +wrap_Range :: T_Range -> Inh_Range -> (Syn_Range ) +wrap_Range (T_Range act) (Inh_Range ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Range_vIn133 + (T_Range_vOut133 _lhsOself) <- return (inv_Range_s134 sem arg) + return (Syn_Range _lhsOself) + ) + +-- cata +{-# INLINE sem_Range #-} +sem_Range :: Range -> T_Range +sem_Range ( Range_Range start_ stop_ ) = sem_Range_Range ( sem_Position start_ ) ( sem_Position stop_ ) + +-- semantic domain +newtype T_Range = T_Range { + attach_T_Range :: Identity (T_Range_s134 ) + } +newtype T_Range_s134 = C_Range_s134 { + inv_Range_s134 :: (T_Range_v133 ) + } +data T_Range_s135 = C_Range_s135 +type T_Range_v133 = (T_Range_vIn133 ) -> (T_Range_vOut133 ) +data T_Range_vIn133 = T_Range_vIn133 +data T_Range_vOut133 = T_Range_vOut133 (Range) +{-# NOINLINE sem_Range_Range #-} +sem_Range_Range :: T_Position -> T_Position -> T_Range +sem_Range_Range arg_start_ arg_stop_ = T_Range (return st134) where + {-# NOINLINE st134 #-} + st134 = let + v133 :: T_Range_v133 + v133 = \ (T_Range_vIn133 ) -> ( let + _startX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_start_)) + _stopX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_stop_)) + (T_Position_vOut124 _startIself) = inv_Position_s125 _startX125 (T_Position_vIn124 ) + (T_Position_vOut124 _stopIself) = inv_Position_s125 _stopX125 (T_Position_vIn124 ) + _self = rule526 _startIself _stopIself + _lhsOself :: Range + _lhsOself = rule527 _self + __result_ = T_Range_vOut133 _lhsOself + in __result_ ) + in C_Range_s134 v133 + {-# INLINE rule526 #-} + rule526 = \ ((_startIself) :: Position) ((_stopIself) :: Position) -> + Range_Range _startIself _stopIself + {-# INLINE rule527 #-} + rule527 = \ _self -> + _self + +-- RecordExpressionBinding ------------------------------------- +-- wrapper +data Inh_RecordExpressionBinding = Inh_RecordExpressionBinding { opTable_Inh_RecordExpressionBinding :: (OperatorTable), resolveErrors_Inh_RecordExpressionBinding :: ( [ResolveError] ) } +data Syn_RecordExpressionBinding = Syn_RecordExpressionBinding { resolveErrors_Syn_RecordExpressionBinding :: ( [ResolveError] ), self_Syn_RecordExpressionBinding :: (RecordExpressionBinding) } +{-# INLINABLE wrap_RecordExpressionBinding #-} +wrap_RecordExpressionBinding :: T_RecordExpressionBinding -> Inh_RecordExpressionBinding -> (Syn_RecordExpressionBinding ) +wrap_RecordExpressionBinding (T_RecordExpressionBinding act) (Inh_RecordExpressionBinding _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBinding_vIn136 _lhsIopTable _lhsIresolveErrors + (T_RecordExpressionBinding_vOut136 _lhsOresolveErrors _lhsOself) <- return (inv_RecordExpressionBinding_s137 sem arg) + return (Syn_RecordExpressionBinding _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBinding #-} +sem_RecordExpressionBinding :: RecordExpressionBinding -> T_RecordExpressionBinding +sem_RecordExpressionBinding ( RecordExpressionBinding_RecordExpressionBinding range_ name_ expression_ ) = sem_RecordExpressionBinding_RecordExpressionBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_RecordExpressionBinding = T_RecordExpressionBinding { + attach_T_RecordExpressionBinding :: Identity (T_RecordExpressionBinding_s137 ) + } +newtype T_RecordExpressionBinding_s137 = C_RecordExpressionBinding_s137 { + inv_RecordExpressionBinding_s137 :: (T_RecordExpressionBinding_v136 ) + } +data T_RecordExpressionBinding_s138 = C_RecordExpressionBinding_s138 +type T_RecordExpressionBinding_v136 = (T_RecordExpressionBinding_vIn136 ) -> (T_RecordExpressionBinding_vOut136 ) +data T_RecordExpressionBinding_vIn136 = T_RecordExpressionBinding_vIn136 (OperatorTable) ( [ResolveError] ) +data T_RecordExpressionBinding_vOut136 = T_RecordExpressionBinding_vOut136 ( [ResolveError] ) (RecordExpressionBinding) +{-# NOINLINE sem_RecordExpressionBinding_RecordExpressionBinding #-} +sem_RecordExpressionBinding_RecordExpressionBinding :: T_Range -> T_Name -> T_Expression -> T_RecordExpressionBinding +sem_RecordExpressionBinding_RecordExpressionBinding arg_range_ arg_name_ arg_expression_ = T_RecordExpressionBinding (return st137) where + {-# NOINLINE st137 #-} + st137 = let + v136 :: T_RecordExpressionBinding_v136 + v136 = \ (T_RecordExpressionBinding_vIn136 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule528 _expressionIself _nameIself _rangeIself + _lhsOself :: RecordExpressionBinding + _lhsOself = rule529 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule530 _expressionIresolveErrors + _expressionOopTable = rule531 _lhsIopTable + _expressionOresolveErrors = rule532 _lhsIresolveErrors + __result_ = T_RecordExpressionBinding_vOut136 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_RecordExpressionBinding_s137 v136 + {-# INLINE rule528 #-} + rule528 = \ ((_expressionIself) :: Expression) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + RecordExpressionBinding_RecordExpressionBinding _rangeIself _nameIself _expressionIself + {-# INLINE rule529 #-} + rule529 = \ _self -> + _self + {-# INLINE rule530 #-} + rule530 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule531 #-} + rule531 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule532 #-} + rule532 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- RecordExpressionBindings ------------------------------------ +-- wrapper +data Inh_RecordExpressionBindings = Inh_RecordExpressionBindings { opTable_Inh_RecordExpressionBindings :: (OperatorTable), resolveErrors_Inh_RecordExpressionBindings :: ( [ResolveError] ) } +data Syn_RecordExpressionBindings = Syn_RecordExpressionBindings { resolveErrors_Syn_RecordExpressionBindings :: ( [ResolveError] ), self_Syn_RecordExpressionBindings :: (RecordExpressionBindings) } +{-# INLINABLE wrap_RecordExpressionBindings #-} +wrap_RecordExpressionBindings :: T_RecordExpressionBindings -> Inh_RecordExpressionBindings -> (Syn_RecordExpressionBindings ) +wrap_RecordExpressionBindings (T_RecordExpressionBindings act) (Inh_RecordExpressionBindings _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBindings_vIn139 _lhsIopTable _lhsIresolveErrors + (T_RecordExpressionBindings_vOut139 _lhsOresolveErrors _lhsOself) <- return (inv_RecordExpressionBindings_s140 sem arg) + return (Syn_RecordExpressionBindings _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBindings #-} +sem_RecordExpressionBindings :: RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings list = Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list) + +-- semantic domain +newtype T_RecordExpressionBindings = T_RecordExpressionBindings { + attach_T_RecordExpressionBindings :: Identity (T_RecordExpressionBindings_s140 ) + } +newtype T_RecordExpressionBindings_s140 = C_RecordExpressionBindings_s140 { + inv_RecordExpressionBindings_s140 :: (T_RecordExpressionBindings_v139 ) + } +data T_RecordExpressionBindings_s141 = C_RecordExpressionBindings_s141 +type T_RecordExpressionBindings_v139 = (T_RecordExpressionBindings_vIn139 ) -> (T_RecordExpressionBindings_vOut139 ) +data T_RecordExpressionBindings_vIn139 = T_RecordExpressionBindings_vIn139 (OperatorTable) ( [ResolveError] ) +data T_RecordExpressionBindings_vOut139 = T_RecordExpressionBindings_vOut139 ( [ResolveError] ) (RecordExpressionBindings) +{-# NOINLINE sem_RecordExpressionBindings_Cons #-} +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> T_RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons arg_hd_ arg_tl_ = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 _lhsIopTable _lhsIresolveErrors) -> ( let + _hdX137 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBinding (arg_hd_)) + _tlX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_tl_)) + (T_RecordExpressionBinding_vOut136 _hdIresolveErrors _hdIself) = inv_RecordExpressionBinding_s137 _hdX137 (T_RecordExpressionBinding_vIn136 _hdOopTable _hdOresolveErrors) + (T_RecordExpressionBindings_vOut139 _tlIresolveErrors _tlIself) = inv_RecordExpressionBindings_s140 _tlX140 (T_RecordExpressionBindings_vIn139 _tlOopTable _tlOresolveErrors) + _self = rule533 _hdIself _tlIself + _lhsOself :: RecordExpressionBindings + _lhsOself = rule534 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule535 _tlIresolveErrors + _hdOopTable = rule536 _lhsIopTable + _hdOresolveErrors = rule537 _lhsIresolveErrors + _tlOopTable = rule538 _lhsIopTable + _tlOresolveErrors = rule539 _hdIresolveErrors + __result_ = T_RecordExpressionBindings_vOut139 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule533 #-} + rule533 = \ ((_hdIself) :: RecordExpressionBinding) ((_tlIself) :: RecordExpressionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule534 #-} + rule534 = \ _self -> + _self + {-# INLINE rule535 #-} + rule535 = \ ((_tlIresolveErrors) :: [ResolveError] ) -> + _tlIresolveErrors + {-# INLINE rule536 #-} + rule536 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule537 #-} + rule537 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule538 #-} + rule538 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule539 #-} + rule539 = \ ((_hdIresolveErrors) :: [ResolveError] ) -> + _hdIresolveErrors +{-# NOINLINE sem_RecordExpressionBindings_Nil #-} +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule540 () + _lhsOself :: RecordExpressionBindings + _lhsOself = rule541 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule542 _lhsIresolveErrors + __result_ = T_RecordExpressionBindings_vOut139 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule540 #-} + rule540 = \ (_ :: ()) -> + [] + {-# INLINE rule541 #-} + rule541 = \ _self -> + _self + {-# INLINE rule542 #-} + rule542 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- RecordPatternBinding ---------------------------------------- +-- wrapper +data Inh_RecordPatternBinding = Inh_RecordPatternBinding { opTable_Inh_RecordPatternBinding :: (OperatorTable), resolveErrors_Inh_RecordPatternBinding :: ( [ResolveError] ) } +data Syn_RecordPatternBinding = Syn_RecordPatternBinding { resolveErrors_Syn_RecordPatternBinding :: ( [ResolveError] ), self_Syn_RecordPatternBinding :: (RecordPatternBinding) } +{-# INLINABLE wrap_RecordPatternBinding #-} +wrap_RecordPatternBinding :: T_RecordPatternBinding -> Inh_RecordPatternBinding -> (Syn_RecordPatternBinding ) +wrap_RecordPatternBinding (T_RecordPatternBinding act) (Inh_RecordPatternBinding _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBinding_vIn142 _lhsIopTable _lhsIresolveErrors + (T_RecordPatternBinding_vOut142 _lhsOresolveErrors _lhsOself) <- return (inv_RecordPatternBinding_s143 sem arg) + return (Syn_RecordPatternBinding _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBinding #-} +sem_RecordPatternBinding :: RecordPatternBinding -> T_RecordPatternBinding +sem_RecordPatternBinding ( RecordPatternBinding_RecordPatternBinding range_ name_ pattern_ ) = sem_RecordPatternBinding_RecordPatternBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) + +-- semantic domain +newtype T_RecordPatternBinding = T_RecordPatternBinding { + attach_T_RecordPatternBinding :: Identity (T_RecordPatternBinding_s143 ) + } +newtype T_RecordPatternBinding_s143 = C_RecordPatternBinding_s143 { + inv_RecordPatternBinding_s143 :: (T_RecordPatternBinding_v142 ) + } +data T_RecordPatternBinding_s144 = C_RecordPatternBinding_s144 +type T_RecordPatternBinding_v142 = (T_RecordPatternBinding_vIn142 ) -> (T_RecordPatternBinding_vOut142 ) +data T_RecordPatternBinding_vIn142 = T_RecordPatternBinding_vIn142 (OperatorTable) ( [ResolveError] ) +data T_RecordPatternBinding_vOut142 = T_RecordPatternBinding_vOut142 ( [ResolveError] ) (RecordPatternBinding) +{-# NOINLINE sem_RecordPatternBinding_RecordPatternBinding #-} +sem_RecordPatternBinding_RecordPatternBinding :: T_Range -> T_Name -> T_Pattern -> T_RecordPatternBinding +sem_RecordPatternBinding_RecordPatternBinding arg_range_ arg_name_ arg_pattern_ = T_RecordPatternBinding (return st143) where + {-# NOINLINE st143 #-} + st143 = let + v142 :: T_RecordPatternBinding_v142 + v142 = \ (T_RecordPatternBinding_vIn142 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIresolveErrors _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOopTable _patternOresolveErrors) + _self = rule543 _nameIself _patternIself _rangeIself + _lhsOself :: RecordPatternBinding + _lhsOself = rule544 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule545 _patternIresolveErrors + _patternOopTable = rule546 _lhsIopTable + _patternOresolveErrors = rule547 _lhsIresolveErrors + __result_ = T_RecordPatternBinding_vOut142 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_RecordPatternBinding_s143 v142 + {-# INLINE rule543 #-} + rule543 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + RecordPatternBinding_RecordPatternBinding _rangeIself _nameIself _patternIself + {-# INLINE rule544 #-} + rule544 = \ _self -> + _self + {-# INLINE rule545 #-} + rule545 = \ ((_patternIresolveErrors) :: [ResolveError] ) -> + _patternIresolveErrors + {-# INLINE rule546 #-} + rule546 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule547 #-} + rule547 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- RecordPatternBindings --------------------------------------- +-- wrapper +data Inh_RecordPatternBindings = Inh_RecordPatternBindings { opTable_Inh_RecordPatternBindings :: (OperatorTable), resolveErrors_Inh_RecordPatternBindings :: ( [ResolveError] ) } +data Syn_RecordPatternBindings = Syn_RecordPatternBindings { resolveErrors_Syn_RecordPatternBindings :: ( [ResolveError] ), self_Syn_RecordPatternBindings :: (RecordPatternBindings) } +{-# INLINABLE wrap_RecordPatternBindings #-} +wrap_RecordPatternBindings :: T_RecordPatternBindings -> Inh_RecordPatternBindings -> (Syn_RecordPatternBindings ) +wrap_RecordPatternBindings (T_RecordPatternBindings act) (Inh_RecordPatternBindings _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBindings_vIn145 _lhsIopTable _lhsIresolveErrors + (T_RecordPatternBindings_vOut145 _lhsOresolveErrors _lhsOself) <- return (inv_RecordPatternBindings_s146 sem arg) + return (Syn_RecordPatternBindings _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBindings #-} +sem_RecordPatternBindings :: RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings list = Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list) + +-- semantic domain +newtype T_RecordPatternBindings = T_RecordPatternBindings { + attach_T_RecordPatternBindings :: Identity (T_RecordPatternBindings_s146 ) + } +newtype T_RecordPatternBindings_s146 = C_RecordPatternBindings_s146 { + inv_RecordPatternBindings_s146 :: (T_RecordPatternBindings_v145 ) + } +data T_RecordPatternBindings_s147 = C_RecordPatternBindings_s147 +type T_RecordPatternBindings_v145 = (T_RecordPatternBindings_vIn145 ) -> (T_RecordPatternBindings_vOut145 ) +data T_RecordPatternBindings_vIn145 = T_RecordPatternBindings_vIn145 (OperatorTable) ( [ResolveError] ) +data T_RecordPatternBindings_vOut145 = T_RecordPatternBindings_vOut145 ( [ResolveError] ) (RecordPatternBindings) +{-# NOINLINE sem_RecordPatternBindings_Cons #-} +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> T_RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings_Cons arg_hd_ arg_tl_ = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 _lhsIopTable _lhsIresolveErrors) -> ( let + _hdX143 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBinding (arg_hd_)) + _tlX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_tl_)) + (T_RecordPatternBinding_vOut142 _hdIresolveErrors _hdIself) = inv_RecordPatternBinding_s143 _hdX143 (T_RecordPatternBinding_vIn142 _hdOopTable _hdOresolveErrors) + (T_RecordPatternBindings_vOut145 _tlIresolveErrors _tlIself) = inv_RecordPatternBindings_s146 _tlX146 (T_RecordPatternBindings_vIn145 _tlOopTable _tlOresolveErrors) + _self = rule548 _hdIself _tlIself + _lhsOself :: RecordPatternBindings + _lhsOself = rule549 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule550 _tlIresolveErrors + _hdOopTable = rule551 _lhsIopTable + _hdOresolveErrors = rule552 _lhsIresolveErrors + _tlOopTable = rule553 _lhsIopTable + _tlOresolveErrors = rule554 _hdIresolveErrors + __result_ = T_RecordPatternBindings_vOut145 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule548 #-} + rule548 = \ ((_hdIself) :: RecordPatternBinding) ((_tlIself) :: RecordPatternBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule549 #-} + rule549 = \ _self -> + _self + {-# INLINE rule550 #-} + rule550 = \ ((_tlIresolveErrors) :: [ResolveError] ) -> + _tlIresolveErrors + {-# INLINE rule551 #-} + rule551 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule552 #-} + rule552 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule553 #-} + rule553 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule554 #-} + rule554 = \ ((_hdIresolveErrors) :: [ResolveError] ) -> + _hdIresolveErrors +{-# NOINLINE sem_RecordPatternBindings_Nil #-} +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule555 () + _lhsOself :: RecordPatternBindings + _lhsOself = rule556 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule557 _lhsIresolveErrors + __result_ = T_RecordPatternBindings_vOut145 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule555 #-} + rule555 = \ (_ :: ()) -> + [] + {-# INLINE rule556 #-} + rule556 = \ _self -> + _self + {-# INLINE rule557 #-} + rule557 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- RightHandSide ----------------------------------------------- +-- wrapper +data Inh_RightHandSide = Inh_RightHandSide { opTable_Inh_RightHandSide :: (OperatorTable), resolveErrors_Inh_RightHandSide :: ( [ResolveError] ) } +data Syn_RightHandSide = Syn_RightHandSide { resolveErrors_Syn_RightHandSide :: ( [ResolveError] ), self_Syn_RightHandSide :: (RightHandSide) } +{-# INLINABLE wrap_RightHandSide #-} +wrap_RightHandSide :: T_RightHandSide -> Inh_RightHandSide -> (Syn_RightHandSide ) +wrap_RightHandSide (T_RightHandSide act) (Inh_RightHandSide _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RightHandSide_vIn148 _lhsIopTable _lhsIresolveErrors + (T_RightHandSide_vOut148 _lhsOresolveErrors _lhsOself) <- return (inv_RightHandSide_s149 sem arg) + return (Syn_RightHandSide _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RightHandSide #-} +sem_RightHandSide :: RightHandSide -> T_RightHandSide +sem_RightHandSide ( RightHandSide_Expression range_ expression_ where_ ) = sem_RightHandSide_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_MaybeDeclarations where_ ) +sem_RightHandSide ( RightHandSide_Guarded range_ guardedexpressions_ where_ ) = sem_RightHandSide_Guarded ( sem_Range range_ ) ( sem_GuardedExpressions guardedexpressions_ ) ( sem_MaybeDeclarations where_ ) + +-- semantic domain +newtype T_RightHandSide = T_RightHandSide { + attach_T_RightHandSide :: Identity (T_RightHandSide_s149 ) + } +newtype T_RightHandSide_s149 = C_RightHandSide_s149 { + inv_RightHandSide_s149 :: (T_RightHandSide_v148 ) + } +data T_RightHandSide_s150 = C_RightHandSide_s150 +type T_RightHandSide_v148 = (T_RightHandSide_vIn148 ) -> (T_RightHandSide_vOut148 ) +data T_RightHandSide_vIn148 = T_RightHandSide_vIn148 (OperatorTable) ( [ResolveError] ) +data T_RightHandSide_vOut148 = T_RightHandSide_vOut148 ( [ResolveError] ) (RightHandSide) +{-# NOINLINE sem_RightHandSide_Expression #-} +sem_RightHandSide_Expression :: T_Range -> T_Expression -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Expression arg_range_ arg_expression_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + (T_MaybeDeclarations_vOut88 _whereIresolveErrors _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOopTable _whereOresolveErrors) + _self = rule558 _expressionIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule559 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule560 _whereIresolveErrors + _expressionOopTable = rule561 _lhsIopTable + _expressionOresolveErrors = rule562 _lhsIresolveErrors + _whereOopTable = rule563 _lhsIopTable + _whereOresolveErrors = rule564 _expressionIresolveErrors + __result_ = T_RightHandSide_vOut148 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule558 #-} + rule558 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Expression _rangeIself _expressionIself _whereIself + {-# INLINE rule559 #-} + rule559 = \ _self -> + _self + {-# INLINE rule560 #-} + rule560 = \ ((_whereIresolveErrors) :: [ResolveError] ) -> + _whereIresolveErrors + {-# INLINE rule561 #-} + rule561 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule562 #-} + rule562 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule563 #-} + rule563 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule564 #-} + rule564 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors +{-# NOINLINE sem_RightHandSide_Guarded #-} +sem_RightHandSide_Guarded :: T_Range -> T_GuardedExpressions -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Guarded arg_range_ arg_guardedexpressions_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardedexpressionsX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_guardedexpressions_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_GuardedExpressions_vOut64 _guardedexpressionsIresolveErrors _guardedexpressionsIself) = inv_GuardedExpressions_s65 _guardedexpressionsX65 (T_GuardedExpressions_vIn64 _guardedexpressionsOopTable _guardedexpressionsOresolveErrors) + (T_MaybeDeclarations_vOut88 _whereIresolveErrors _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOopTable _whereOresolveErrors) + _self = rule565 _guardedexpressionsIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule566 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule567 _whereIresolveErrors + _guardedexpressionsOopTable = rule568 _lhsIopTable + _guardedexpressionsOresolveErrors = rule569 _lhsIresolveErrors + _whereOopTable = rule570 _lhsIopTable + _whereOresolveErrors = rule571 _guardedexpressionsIresolveErrors + __result_ = T_RightHandSide_vOut148 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule565 #-} + rule565 = \ ((_guardedexpressionsIself) :: GuardedExpressions) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Guarded _rangeIself _guardedexpressionsIself _whereIself + {-# INLINE rule566 #-} + rule566 = \ _self -> + _self + {-# INLINE rule567 #-} + rule567 = \ ((_whereIresolveErrors) :: [ResolveError] ) -> + _whereIresolveErrors + {-# INLINE rule568 #-} + rule568 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule569 #-} + rule569 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule570 #-} + rule570 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule571 #-} + rule571 = \ ((_guardedexpressionsIresolveErrors) :: [ResolveError] ) -> + _guardedexpressionsIresolveErrors + +-- SimpleType -------------------------------------------------- +-- wrapper +data Inh_SimpleType = Inh_SimpleType { } +data Syn_SimpleType = Syn_SimpleType { self_Syn_SimpleType :: (SimpleType) } +{-# INLINABLE wrap_SimpleType #-} +wrap_SimpleType :: T_SimpleType -> Inh_SimpleType -> (Syn_SimpleType ) +wrap_SimpleType (T_SimpleType act) (Inh_SimpleType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_SimpleType_vIn151 + (T_SimpleType_vOut151 _lhsOself) <- return (inv_SimpleType_s152 sem arg) + return (Syn_SimpleType _lhsOself) + ) + +-- cata +{-# INLINE sem_SimpleType #-} +sem_SimpleType :: SimpleType -> T_SimpleType +sem_SimpleType ( SimpleType_SimpleType range_ name_ typevariables_ ) = sem_SimpleType_SimpleType ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Names typevariables_ ) + +-- semantic domain +newtype T_SimpleType = T_SimpleType { + attach_T_SimpleType :: Identity (T_SimpleType_s152 ) + } +newtype T_SimpleType_s152 = C_SimpleType_s152 { + inv_SimpleType_s152 :: (T_SimpleType_v151 ) + } +data T_SimpleType_s153 = C_SimpleType_s153 +type T_SimpleType_v151 = (T_SimpleType_vIn151 ) -> (T_SimpleType_vOut151 ) +data T_SimpleType_vIn151 = T_SimpleType_vIn151 +data T_SimpleType_vOut151 = T_SimpleType_vOut151 (SimpleType) +{-# NOINLINE sem_SimpleType_SimpleType #-} +sem_SimpleType_SimpleType :: T_Range -> T_Name -> T_Names -> T_SimpleType +sem_SimpleType_SimpleType arg_range_ arg_name_ arg_typevariables_ = T_SimpleType (return st152) where + {-# NOINLINE st152 #-} + st152 = let + v151 :: T_SimpleType_v151 + v151 = \ (T_SimpleType_vIn151 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + _self = rule572 _nameIself _rangeIself _typevariablesIself + _lhsOself :: SimpleType + _lhsOself = rule573 _self + __result_ = T_SimpleType_vOut151 _lhsOself + in __result_ ) + in C_SimpleType_s152 v151 + {-# INLINE rule572 #-} + rule572 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typevariablesIself) :: Names) -> + SimpleType_SimpleType _rangeIself _nameIself _typevariablesIself + {-# INLINE rule573 #-} + rule573 = \ _self -> + _self + +-- Statement --------------------------------------------------- +-- wrapper +data Inh_Statement = Inh_Statement { opTable_Inh_Statement :: (OperatorTable), resolveErrors_Inh_Statement :: ( [ResolveError] ) } +data Syn_Statement = Syn_Statement { resolveErrors_Syn_Statement :: ( [ResolveError] ), self_Syn_Statement :: (Statement) } +{-# INLINABLE wrap_Statement #-} +wrap_Statement :: T_Statement -> Inh_Statement -> (Syn_Statement ) +wrap_Statement (T_Statement act) (Inh_Statement _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statement_vIn154 _lhsIopTable _lhsIresolveErrors + (T_Statement_vOut154 _lhsOresolveErrors _lhsOself) <- return (inv_Statement_s155 sem arg) + return (Syn_Statement _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statement #-} +sem_Statement :: Statement -> T_Statement +sem_Statement ( Statement_Expression range_ expression_ ) = sem_Statement_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Let range_ declarations_ ) = sem_Statement_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Statement ( Statement_Generator range_ pattern_ expression_ ) = sem_Statement_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Empty range_ ) = sem_Statement_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Statement = T_Statement { + attach_T_Statement :: Identity (T_Statement_s155 ) + } +newtype T_Statement_s155 = C_Statement_s155 { + inv_Statement_s155 :: (T_Statement_v154 ) + } +data T_Statement_s156 = C_Statement_s156 +type T_Statement_v154 = (T_Statement_vIn154 ) -> (T_Statement_vOut154 ) +data T_Statement_vIn154 = T_Statement_vIn154 (OperatorTable) ( [ResolveError] ) +data T_Statement_vOut154 = T_Statement_vOut154 ( [ResolveError] ) (Statement) +{-# NOINLINE sem_Statement_Expression #-} +sem_Statement_Expression :: T_Range -> T_Expression -> T_Statement +sem_Statement_Expression arg_range_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule574 _expressionIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule575 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule576 _expressionIresolveErrors + _expressionOopTable = rule577 _lhsIopTable + _expressionOresolveErrors = rule578 _lhsIresolveErrors + __result_ = T_Statement_vOut154 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule574 #-} + rule574 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Statement_Expression _rangeIself _expressionIself + {-# INLINE rule575 #-} + rule575 = \ _self -> + _self + {-# INLINE rule576 #-} + rule576 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule577 #-} + rule577 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule578 #-} + rule578 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Statement_Let #-} +sem_Statement_Let :: T_Range -> T_Declarations -> T_Statement +sem_Statement_Let arg_range_ arg_declarations_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIresolveErrors _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOopTable _declarationsOresolveErrors) + _self = rule579 _declarationsIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule580 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule581 _declarationsIresolveErrors + _declarationsOopTable = rule582 _lhsIopTable + _declarationsOresolveErrors = rule583 _lhsIresolveErrors + __result_ = T_Statement_vOut154 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule579 #-} + rule579 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Statement_Let _rangeIself _declarationsIself + {-# INLINE rule580 #-} + rule580 = \ _self -> + _self + {-# INLINE rule581 #-} + rule581 = \ ((_declarationsIresolveErrors) :: [ResolveError] ) -> + _declarationsIresolveErrors + {-# INLINE rule582 #-} + rule582 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule583 #-} + rule583 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors +{-# NOINLINE sem_Statement_Generator #-} +sem_Statement_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Statement +sem_Statement_Generator arg_range_ arg_pattern_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIresolveErrors _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOopTable _patternOresolveErrors) + (T_Expression_vOut40 _expressionIresolveErrors _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOopTable _expressionOresolveErrors) + _self = rule584 _expressionIself _patternIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule585 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule586 _expressionIresolveErrors + _patternOopTable = rule587 _lhsIopTable + _patternOresolveErrors = rule588 _lhsIresolveErrors + _expressionOopTable = rule589 _lhsIopTable + _expressionOresolveErrors = rule590 _patternIresolveErrors + __result_ = T_Statement_vOut154 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule584 #-} + rule584 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Statement_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule585 #-} + rule585 = \ _self -> + _self + {-# INLINE rule586 #-} + rule586 = \ ((_expressionIresolveErrors) :: [ResolveError] ) -> + _expressionIresolveErrors + {-# INLINE rule587 #-} + rule587 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule588 #-} + rule588 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule589 #-} + rule589 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule590 #-} + rule590 = \ ((_patternIresolveErrors) :: [ResolveError] ) -> + _patternIresolveErrors +{-# NOINLINE sem_Statement_Empty #-} +sem_Statement_Empty :: T_Range -> T_Statement +sem_Statement_Empty arg_range_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIopTable _lhsIresolveErrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule591 _rangeIself + _lhsOself :: Statement + _lhsOself = rule592 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule593 _lhsIresolveErrors + __result_ = T_Statement_vOut154 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule591 #-} + rule591 = \ ((_rangeIself) :: Range) -> + Statement_Empty _rangeIself + {-# INLINE rule592 #-} + rule592 = \ _self -> + _self + {-# INLINE rule593 #-} + rule593 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Statements -------------------------------------------------- +-- wrapper +data Inh_Statements = Inh_Statements { opTable_Inh_Statements :: (OperatorTable), resolveErrors_Inh_Statements :: ( [ResolveError] ) } +data Syn_Statements = Syn_Statements { resolveErrors_Syn_Statements :: ( [ResolveError] ), self_Syn_Statements :: (Statements) } +{-# INLINABLE wrap_Statements #-} +wrap_Statements :: T_Statements -> Inh_Statements -> (Syn_Statements ) +wrap_Statements (T_Statements act) (Inh_Statements _lhsIopTable _lhsIresolveErrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statements_vIn157 _lhsIopTable _lhsIresolveErrors + (T_Statements_vOut157 _lhsOresolveErrors _lhsOself) <- return (inv_Statements_s158 sem arg) + return (Syn_Statements _lhsOresolveErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statements #-} +sem_Statements :: Statements -> T_Statements +sem_Statements list = Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list) + +-- semantic domain +newtype T_Statements = T_Statements { + attach_T_Statements :: Identity (T_Statements_s158 ) + } +newtype T_Statements_s158 = C_Statements_s158 { + inv_Statements_s158 :: (T_Statements_v157 ) + } +data T_Statements_s159 = C_Statements_s159 +type T_Statements_v157 = (T_Statements_vIn157 ) -> (T_Statements_vOut157 ) +data T_Statements_vIn157 = T_Statements_vIn157 (OperatorTable) ( [ResolveError] ) +data T_Statements_vOut157 = T_Statements_vOut157 ( [ResolveError] ) (Statements) +{-# NOINLINE sem_Statements_Cons #-} +sem_Statements_Cons :: T_Statement -> T_Statements -> T_Statements +sem_Statements_Cons arg_hd_ arg_tl_ = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 _lhsIopTable _lhsIresolveErrors) -> ( let + _hdX155 = Control.Monad.Identity.runIdentity (attach_T_Statement (arg_hd_)) + _tlX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_tl_)) + (T_Statement_vOut154 _hdIresolveErrors _hdIself) = inv_Statement_s155 _hdX155 (T_Statement_vIn154 _hdOopTable _hdOresolveErrors) + (T_Statements_vOut157 _tlIresolveErrors _tlIself) = inv_Statements_s158 _tlX158 (T_Statements_vIn157 _tlOopTable _tlOresolveErrors) + _self = rule594 _hdIself _tlIself + _lhsOself :: Statements + _lhsOself = rule595 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule596 _tlIresolveErrors + _hdOopTable = rule597 _lhsIopTable + _hdOresolveErrors = rule598 _lhsIresolveErrors + _tlOopTable = rule599 _lhsIopTable + _tlOresolveErrors = rule600 _hdIresolveErrors + __result_ = T_Statements_vOut157 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule594 #-} + rule594 = \ ((_hdIself) :: Statement) ((_tlIself) :: Statements) -> + (:) _hdIself _tlIself + {-# INLINE rule595 #-} + rule595 = \ _self -> + _self + {-# INLINE rule596 #-} + rule596 = \ ((_tlIresolveErrors) :: [ResolveError] ) -> + _tlIresolveErrors + {-# INLINE rule597 #-} + rule597 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule598 #-} + rule598 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + {-# INLINE rule599 #-} + rule599 = \ ((_lhsIopTable) :: OperatorTable) -> + _lhsIopTable + {-# INLINE rule600 #-} + rule600 = \ ((_hdIresolveErrors) :: [ResolveError] ) -> + _hdIresolveErrors +{-# NOINLINE sem_Statements_Nil #-} +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 _lhsIopTable _lhsIresolveErrors) -> ( let + _self = rule601 () + _lhsOself :: Statements + _lhsOself = rule602 _self + _lhsOresolveErrors :: [ResolveError] + _lhsOresolveErrors = rule603 _lhsIresolveErrors + __result_ = T_Statements_vOut157 _lhsOresolveErrors _lhsOself + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule601 #-} + rule601 = \ (_ :: ()) -> + [] + {-# INLINE rule602 #-} + rule602 = \ _self -> + _self + {-# INLINE rule603 #-} + rule603 = \ ((_lhsIresolveErrors) :: [ResolveError] ) -> + _lhsIresolveErrors + +-- Strings ----------------------------------------------------- +-- wrapper +data Inh_Strings = Inh_Strings { } +data Syn_Strings = Syn_Strings { self_Syn_Strings :: (Strings) } +{-# INLINABLE wrap_Strings #-} +wrap_Strings :: T_Strings -> Inh_Strings -> (Syn_Strings ) +wrap_Strings (T_Strings act) (Inh_Strings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Strings_vIn160 + (T_Strings_vOut160 _lhsOself) <- return (inv_Strings_s161 sem arg) + return (Syn_Strings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Strings #-} +sem_Strings :: Strings -> T_Strings +sem_Strings list = Prelude.foldr sem_Strings_Cons sem_Strings_Nil list + +-- semantic domain +newtype T_Strings = T_Strings { + attach_T_Strings :: Identity (T_Strings_s161 ) + } +newtype T_Strings_s161 = C_Strings_s161 { + inv_Strings_s161 :: (T_Strings_v160 ) + } +data T_Strings_s162 = C_Strings_s162 +type T_Strings_v160 = (T_Strings_vIn160 ) -> (T_Strings_vOut160 ) +data T_Strings_vIn160 = T_Strings_vIn160 +data T_Strings_vOut160 = T_Strings_vOut160 (Strings) +{-# NOINLINE sem_Strings_Cons #-} +sem_Strings_Cons :: (String) -> T_Strings -> T_Strings +sem_Strings_Cons arg_hd_ arg_tl_ = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _tlX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_tl_)) + (T_Strings_vOut160 _tlIself) = inv_Strings_s161 _tlX161 (T_Strings_vIn160 ) + _self = rule604 _tlIself arg_hd_ + _lhsOself :: Strings + _lhsOself = rule605 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule604 #-} + rule604 = \ ((_tlIself) :: Strings) hd_ -> + (:) hd_ _tlIself + {-# INLINE rule605 #-} + rule605 = \ _self -> + _self +{-# NOINLINE sem_Strings_Nil #-} +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _self = rule606 () + _lhsOself :: Strings + _lhsOself = rule607 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule606 #-} + rule606 = \ (_ :: ()) -> + [] + {-# INLINE rule607 #-} + rule607 = \ _self -> + _self + +-- Type -------------------------------------------------------- +-- wrapper +data Inh_Type = Inh_Type { } +data Syn_Type = Syn_Type { self_Syn_Type :: (Type) } +{-# INLINABLE wrap_Type #-} +wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) +wrap_Type (T_Type act) (Inh_Type ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Type_vIn163 + (T_Type_vOut163 _lhsOself) <- return (inv_Type_s164 sem arg) + return (Syn_Type _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Type #-} +sem_Type :: Type -> T_Type +sem_Type ( Type_Application range_ prefix_ function_ arguments_ ) = sem_Type_Application ( sem_Range range_ ) prefix_ ( sem_Type function_ ) ( sem_Types arguments_ ) +sem_Type ( Type_Variable range_ name_ ) = sem_Type_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Constructor range_ name_ ) = sem_Type_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Qualified range_ context_ type_ ) = sem_Type_Qualified ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Type type_ ) +sem_Type ( Type_Forall range_ typevariables_ type_ ) = sem_Type_Forall ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Exists range_ typevariables_ type_ ) = sem_Type_Exists ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Parenthesized range_ type_ ) = sem_Type_Parenthesized ( sem_Range range_ ) ( sem_Type type_ ) + +-- semantic domain +newtype T_Type = T_Type { + attach_T_Type :: Identity (T_Type_s164 ) + } +newtype T_Type_s164 = C_Type_s164 { + inv_Type_s164 :: (T_Type_v163 ) + } +data T_Type_s165 = C_Type_s165 +type T_Type_v163 = (T_Type_vIn163 ) -> (T_Type_vOut163 ) +data T_Type_vIn163 = T_Type_vIn163 +data T_Type_vOut163 = T_Type_vOut163 (Type) +{-# NOINLINE sem_Type_Application #-} +sem_Type_Application :: T_Range -> (Bool) -> T_Type -> T_Types -> T_Type +sem_Type_Application arg_range_ arg_prefix_ arg_function_ arg_arguments_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_function_)) + _argumentsX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _functionIself) = inv_Type_s164 _functionX164 (T_Type_vIn163 ) + (T_Types_vOut166 _argumentsIself) = inv_Types_s167 _argumentsX167 (T_Types_vIn166 ) + _self = rule608 _argumentsIself _functionIself _rangeIself arg_prefix_ + _lhsOself :: Type + _lhsOself = rule609 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule608 #-} + rule608 = \ ((_argumentsIself) :: Types) ((_functionIself) :: Type) ((_rangeIself) :: Range) prefix_ -> + Type_Application _rangeIself prefix_ _functionIself _argumentsIself + {-# INLINE rule609 #-} + rule609 = \ _self -> + _self +{-# NOINLINE sem_Type_Variable #-} +sem_Type_Variable :: T_Range -> T_Name -> T_Type +sem_Type_Variable arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule610 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule611 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule610 #-} + rule610 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Variable _rangeIself _nameIself + {-# INLINE rule611 #-} + rule611 = \ _self -> + _self +{-# NOINLINE sem_Type_Constructor #-} +sem_Type_Constructor :: T_Range -> T_Name -> T_Type +sem_Type_Constructor arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule612 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule613 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule612 #-} + rule612 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Constructor _rangeIself _nameIself + {-# INLINE rule613 #-} + rule613 = \ _self -> + _self +{-# NOINLINE sem_Type_Qualified #-} +sem_Type_Qualified :: T_Range -> T_ContextItems -> T_Type -> T_Type +sem_Type_Qualified arg_range_ arg_context_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule614 _contextIself _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule615 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule614 #-} + rule614 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Qualified _rangeIself _contextIself _typeIself + {-# INLINE rule615 #-} + rule615 = \ _self -> + _self +{-# NOINLINE sem_Type_Forall #-} +sem_Type_Forall :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Forall arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule616 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule617 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule616 #-} + rule616 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Forall _rangeIself _typevariablesIself _typeIself + {-# INLINE rule617 #-} + rule617 = \ _self -> + _self +{-# NOINLINE sem_Type_Exists #-} +sem_Type_Exists :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Exists arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule618 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule619 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule618 #-} + rule618 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Exists _rangeIself _typevariablesIself _typeIself + {-# INLINE rule619 #-} + rule619 = \ _self -> + _self +{-# NOINLINE sem_Type_Parenthesized #-} +sem_Type_Parenthesized :: T_Range -> T_Type -> T_Type +sem_Type_Parenthesized arg_range_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule620 _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule621 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule620 #-} + rule620 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Parenthesized _rangeIself _typeIself + {-# INLINE rule621 #-} + rule621 = \ _self -> + _self + +-- Types ------------------------------------------------------- +-- wrapper +data Inh_Types = Inh_Types { } +data Syn_Types = Syn_Types { self_Syn_Types :: (Types) } +{-# INLINABLE wrap_Types #-} +wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) +wrap_Types (T_Types act) (Inh_Types ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Types_vIn166 + (T_Types_vOut166 _lhsOself) <- return (inv_Types_s167 sem arg) + return (Syn_Types _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Types #-} +sem_Types :: Types -> T_Types +sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) + +-- semantic domain +newtype T_Types = T_Types { + attach_T_Types :: Identity (T_Types_s167 ) + } +newtype T_Types_s167 = C_Types_s167 { + inv_Types_s167 :: (T_Types_v166 ) + } +data T_Types_s168 = C_Types_s168 +type T_Types_v166 = (T_Types_vIn166 ) -> (T_Types_vOut166 ) +data T_Types_vIn166 = T_Types_vIn166 +data T_Types_vOut166 = T_Types_vOut166 (Types) +{-# NOINLINE sem_Types_Cons #-} +sem_Types_Cons :: T_Type -> T_Types -> T_Types +sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _hdX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) + _tlX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) + (T_Type_vOut163 _hdIself) = inv_Type_s164 _hdX164 (T_Type_vIn163 ) + (T_Types_vOut166 _tlIself) = inv_Types_s167 _tlX167 (T_Types_vIn166 ) + _self = rule622 _hdIself _tlIself + _lhsOself :: Types + _lhsOself = rule623 _self + __result_ = T_Types_vOut166 _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule622 #-} + rule622 = \ ((_hdIself) :: Type) ((_tlIself) :: Types) -> + (:) _hdIself _tlIself + {-# INLINE rule623 #-} + rule623 = \ _self -> + _self +{-# NOINLINE sem_Types_Nil #-} +sem_Types_Nil :: T_Types +sem_Types_Nil = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _self = rule624 () + _lhsOself :: Types + _lhsOself = rule625 _self + __result_ = T_Types_vOut166 _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule624 #-} + rule624 = \ (_ :: ()) -> + [] + {-# INLINE rule625 #-} + rule625 = \ _self -> + _self diff --git a/src/Helium/StaticAnalysis/Directives/Matchers.hs b/src/Helium/StaticAnalysis/Directives/Matchers.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/Matchers.hs @@ -0,0 +1,160 @@ +{-| Module : Matchers + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Matching expressions + + (directives based on "Scripting the Type Inference Process", ICFP 2003) +-} + +module Helium.StaticAnalysis.Directives.Matchers where + +import Helium.Syntax.UHA_Syntax +import Helium.StaticAnalysis.Messages.Messages () -- instance Eq Name + +------------------------------------------------------------- +-- Expression + +match_Expression_Literal :: Literal -> Expression -> Maybe () +match_Expression_Literal l1 expr = + case expr of + Expression_Literal _ l2 | l1 `eqLiteral` l2 -> Just () + _ -> Nothing + +match_Expression_Variable :: Name -> Expression -> Maybe () +match_Expression_Variable n1 expr = + case expr of + Expression_Variable _ n2 | n1 == n2 -> Just () + _ -> Nothing + +match_Expression_Constructor :: Name -> Expression -> Maybe () +match_Expression_Constructor n1 expr = + case expr of + Expression_Constructor _ n2 | n1 == n2 -> Just () + _ -> Nothing + +match_Expression_NormalApplication :: Expression -> Maybe (Expression, Expressions) +match_Expression_NormalApplication expr = + case expr of + Expression_NormalApplication _ e es -> Just (e,es) + _ -> Nothing + +match_Expression_InfixApplication :: Expression -> Maybe (MaybeExpression, Expression, MaybeExpression) +match_Expression_InfixApplication expr = + case expr of + Expression_InfixApplication _ me1 e me2 -> Just (me1,e,me2) + _ -> Nothing + +match_Expression_If :: Expression -> Maybe (Expression,Expression,Expression) +match_Expression_If expr = + case expr of + Expression_If _ e1 e2 e3 -> Just (e1,e2,e3) + _ -> Nothing + +match_Expression_Lambda :: Expression -> Maybe (Patterns,Expression) +match_Expression_Lambda expr = + case expr of + Expression_Lambda _ p e -> Just (p,e) + _ -> Nothing + +match_Expression_Case :: Expression -> Maybe (Expression,Alternatives) +match_Expression_Case expr = + case expr of + Expression_Case _ e as -> Just (e,as) + _ -> Nothing + +match_Expression_Let :: Expression -> Maybe (Declarations,Expression) +match_Expression_Let expr = + case expr of + Expression_Let _ ds e -> Just (ds,e) + _ -> Nothing + +match_Expression_Do :: Expression -> Maybe Statements +match_Expression_Do expr = + case expr of + Expression_Do _ ss -> Just ss + _ -> Nothing + +match_Expression_List :: Expression -> Maybe Expressions +match_Expression_List expr = + case expr of + Expression_List _ es -> Just es + _ -> Nothing + +match_Expression_Tuple :: Expression -> Maybe Expressions +match_Expression_Tuple expr = + case expr of + Expression_Tuple _ es -> Just es + _ -> Nothing + +match_Expression_Comprehension :: Expression -> Maybe (Expression,Qualifiers) +match_Expression_Comprehension expr = + case expr of + Expression_Comprehension _ e qs -> Just (e,qs) + _ -> Nothing + +match_Expression_Typed :: Expression -> Maybe (Expression,Type) +match_Expression_Typed expr = + case expr of + Expression_Typed _ e t -> Just (e,t) + _ -> Nothing + +match_Expression_Enum :: Expression -> Maybe (Expression,MaybeExpression,MaybeExpression) +match_Expression_Enum expr = + case expr of + Expression_Enum _ e me1 me2 -> Just (e,me1,me2) + _ -> Nothing + +match_Expression_Negate :: Expression -> Maybe Expression +match_Expression_Negate expr = + case expr of + Expression_Negate _ e -> Just e + _ -> Nothing + +match_Expression_NegateFloat :: Expression -> Maybe Expression +match_Expression_NegateFloat expr = + case expr of + Expression_NegateFloat _ e -> Just e + _ -> Nothing + +------------------------------------------------------------- +-- Expressions + +match_Expressions_Cons :: Expressions -> Maybe (Expression,Expressions) +match_Expressions_Cons exprs = + case exprs of + e:es -> Just (e,es) + _ -> Nothing + +match_Expressions_Nil :: Expressions -> Maybe () +match_Expressions_Nil exprs = + case exprs of + [] -> Just () + _ -> Nothing + +------------------------------------------------------------- +-- MaybeExpression + +match_MaybeExpression_Just :: MaybeExpression -> Maybe Expression +match_MaybeExpression_Just mexpr = + case mexpr of + MaybeExpression_Just e -> Just e + _ -> Nothing + +match_MaybeExpression_Nothing :: MaybeExpression -> Maybe () +match_MaybeExpression_Nothing mexpr = + case mexpr of + MaybeExpression_Nothing -> Just () + _ -> Nothing + +------------------------------------------------------------- + +eqLiteral :: Literal -> Literal -> Bool +eqLiteral (Literal_Char _ x) (Literal_Char _ y) = x == y +eqLiteral (Literal_Float _ x) (Literal_Float _ y) = x == y +eqLiteral (Literal_Int _ x) (Literal_Int _ y) = x == y +eqLiteral (Literal_String _ x) (Literal_String _ y) = x == y +eqLiteral _ _ = False diff --git a/src/Helium/StaticAnalysis/Directives/TS_Analyse.ag b/src/Helium/StaticAnalysis/Directives/TS_Analyse.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_Analyse.ag @@ -0,0 +1,148 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- An analyzer for type inference directives. +-- +-- (directives based on "Scripting the Type Inference Process", ICFP 2003) +----------------------------------------------------------------------------- + +{ +analyseTypingStrategies :: TypingStrategies -> ImportEnvironment -> (TS_Errors, TS_Warnings) +analyseTypingStrategies list ie = + let (as, bs) = unzip (map (\ts -> analyseTypingStrategy ts ie) list) + in (concat as, concat bs) + + +analyseTypingStrategy :: TypingStrategy -> ImportEnvironment -> (TS_Errors, TS_Warnings) +analyseTypingStrategy ts ie = + let res = wrap_TypingStrategy (sem_TypingStrategy ts) Inh_TypingStrategy { importEnvironment_Inh_TypingStrategy = ie } + in (errors_Syn_TypingStrategy res, warnings_Syn_TypingStrategy res) +} + +INCLUDE "UHA_Syntax.ag" +INCLUDE "TS_Syntax.ag" +INCLUDE "TS_Collect.ag" + +imports { +import Top.Types +import Top.Solver.Greedy +import Top.Solver + +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Helium.StaticAnalysis.Directives.TS_Syntax +import Helium.StaticAnalysis.Miscellaneous.TypeConversion +import Data.List +import Helium.Syntax.UHA_Utils (nameFromString) +import Helium.Syntax.UHA_Range (noRange) +import Helium.StaticAnalysis.Messages.Messages +import Helium.StaticAnalysis.Directives.TS_Messages +import Helium.ModuleSystem.ImportEnvironment hiding (setTypeSynonyms) +import Helium.Utils.Utils (internalError) +import qualified Helium.Syntax.UHA_Pretty as PP +} + +ATTR TypingStrategy [ importEnvironment : ImportEnvironment + | + | errors : TS_Errors + warnings : TS_Warnings + ] + +SEM TypingStrategy + | Siblings -- no analysis for siblings (yet) + lhs . errors = [] + . warnings = [] + + | TypingStrategy + loc . name = show (PP.text_Syn_Expression $ PP.wrap_Expression (PP.sem_Expression @typerule.conclusionExpression) PP.Inh_Expression) + . nameMap = zip @uniqueTypevariables (map TVar [0..]) + . errors = @staticErrors ++ @soundnessErrors + . staticErrors = [ InconsistentConstraint @name x | (x, _) <- @solveErrors ] ++ + [ UndefinedTS @name name entity + | (name, entity) <- @typerule.conclusionAllVariables + , show name `notElem` (@allMetaVariables ++ map show @allImportedVariables) + ] ++ + [ UnusedMetaVariable @name s + | s <- @allMetaVariables + , s `notElem` (map (show . fst) @typerule.conclusionAllVariables) + ] ++ + [ DuplicatedMetaVariablesPremise @name x + | x:_ <- findDuplicates @allMetaVariables + ] ++ + [ DuplicatedMetaVariablesConclusion @name x + | let strings = map (show . fst) @typerule.conclusionAllVariables + , x:_ <- findDuplicates (filter (`elem` @allMetaVariables) strings) + ] ++ + [ DuplicatedMetaVariableConstraints @name (show x) + | x:_ <- findDuplicates @statements.metaVariableConstraintNames + ] + . warnings = [] {-case @constraintsNotExplicit of + [] -> [] + xs -> [ MetaVariableConstraintsNotExplicit @name xs ] -} + + -- Solve the constraint set. + . substitution = substitutionFromResult @solveResult + . solveErrors = errorsFromResult @solveResult + . solveResult = + let options = solveOptions { uniqueCounter = length @uniqueTypevariables + , Top.Solver.typeSynonyms = getOrderedTypeSynonyms @lhs.importEnvironment + , classEnvironment = @classEnv + } + in fst (solve options (reverse @statements.userConstraints) greedyConstraintSolver) + + . classEnv = createClassEnvironment @lhs.importEnvironment + + . soundnessErrors = + if not (null @staticErrors) + then [] + else let orderedMetaList = -- consistent ordering of meta variables for soundness check! + reverse @typerule.simpleJudgements + constraintsTpScheme = + let premiseTypes = map snd orderedMetaList + skeletonType = foldr (.->.) @typerule.conclusionType premiseTypes + in generalizeAll (@substitution |-> (@statements.userPredicates .=>. skeletonType)) + (inferredTpScheme, _, inferredTypeErrors) = + let expr = Expression_Lambda noRange pats @typerule.conclusionExpression + pats = map (Pattern_Variable noRange . nameFromString . fst) orderedMetaList + in expressionTypeInferencer @lhs.importEnvironment expr + synonyms = getOrderedTypeSynonyms @lhs.importEnvironment + in if not (null inferredTypeErrors) + then map (TypeErrorTS @name) inferredTypeErrors + else if genericInstanceOf synonyms @classEnv inferredTpScheme constraintsTpScheme + && + genericInstanceOf synonyms @classEnv constraintsTpScheme inferredTpScheme + then [] + else [ Soundness @name inferredTpScheme constraintsTpScheme ] + +-- cheching the names +ATTR Judgement Expression Expressions MaybeExpression [ | | allVariables USE { ++ } { [] } : {[(Name,Entity)]} ] + +SEM Expression + | Variable lhs . allVariables = [(@name.self, Variable)] + | Constructor lhs . allVariables = [(@name.self, Constructor)] + +ATTR TypeRule [ | | conclusionAllVariables : {[(Name,Entity)]} ] +SEM TypeRule | TypeRule lhs . conclusionAllVariables = @conclusion.allVariables + +SEM TypingStrategy + | TypingStrategy + loc.allImportedVariables = + M.keys (typeEnvironment @lhs.importEnvironment) ++ + M.keys (valueConstructors @lhs.importEnvironment) + + + +-- prevent AG-warnings +SEM TypingStrategies | Cons loc . importEnvironment = + internalError "TS_Analyse.ag" "n/a" "TS_Analyse.ag" + +{ +findDuplicates :: Ord a => [a] -> [[a]] +findDuplicates = filter (not . isSingleton) . group . sort + where isSingleton [_] = True + isSingleton _ = False +} diff --git a/src/Helium/StaticAnalysis/Directives/TS_Analyse.hs b/src/Helium/StaticAnalysis/Directives/TS_Analyse.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_Analyse.hs @@ -0,0 +1,6882 @@ +{-# LANGUAGE Rank2Types, GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Helium.StaticAnalysis.Directives.TS_Analyse where + +import Top.Types +import Top.Solver.Greedy +import Top.Solver + +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Helium.StaticAnalysis.Directives.TS_Syntax +import Helium.StaticAnalysis.Miscellaneous.TypeConversion +import Data.List +import Helium.Syntax.UHA_Utils (nameFromString) +import Helium.Syntax.UHA_Range (noRange) +import Helium.StaticAnalysis.Messages.Messages +import Helium.StaticAnalysis.Directives.TS_Messages +import Helium.ModuleSystem.ImportEnvironment hiding (setTypeSynonyms) +import Helium.Utils.Utils (internalError) +import qualified Helium.Syntax.UHA_Pretty as PP + + +import Helium.Syntax.UHA_Syntax + + +import Helium.StaticAnalysis.Inferencers.ExpressionTypeInferencer (expressionTypeInferencer) +import qualified Data.Map as M +import Control.Monad.Identity (Identity) +import qualified Control.Monad.Identity + +analyseTypingStrategies :: TypingStrategies -> ImportEnvironment -> (TS_Errors, TS_Warnings) +analyseTypingStrategies list ie = + let (as, bs) = unzip (map (\ts -> analyseTypingStrategy ts ie) list) + in (concat as, concat bs) + + +analyseTypingStrategy :: TypingStrategy -> ImportEnvironment -> (TS_Errors, TS_Warnings) +analyseTypingStrategy ts ie = + let res = wrap_TypingStrategy (sem_TypingStrategy ts) Inh_TypingStrategy { importEnvironment_Inh_TypingStrategy = ie } + in (errors_Syn_TypingStrategy res, warnings_Syn_TypingStrategy res) + + +findDuplicates :: Ord a => [a] -> [[a]] +findDuplicates = filter (not . isSingleton) . group . sort + where isSingleton [_] = True + isSingleton _ = False +-- Alternative ------------------------------------------------- +-- wrapper +data Inh_Alternative = Inh_Alternative { } +data Syn_Alternative = Syn_Alternative { self_Syn_Alternative :: (Alternative) } +{-# INLINABLE wrap_Alternative #-} +wrap_Alternative :: T_Alternative -> Inh_Alternative -> (Syn_Alternative ) +wrap_Alternative (T_Alternative act) (Inh_Alternative ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternative_vIn1 + (T_Alternative_vOut1 _lhsOself) <- return (inv_Alternative_s2 sem arg) + return (Syn_Alternative _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternative #-} +sem_Alternative :: Alternative -> T_Alternative +sem_Alternative ( Alternative_Hole range_ id_ ) = sem_Alternative_Hole ( sem_Range range_ ) id_ +sem_Alternative ( Alternative_Feedback range_ feedback_ alternative_ ) = sem_Alternative_Feedback ( sem_Range range_ ) feedback_ ( sem_Alternative alternative_ ) +sem_Alternative ( Alternative_Alternative range_ pattern_ righthandside_ ) = sem_Alternative_Alternative ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Alternative ( Alternative_Empty range_ ) = sem_Alternative_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Alternative = T_Alternative { + attach_T_Alternative :: Identity (T_Alternative_s2 ) + } +newtype T_Alternative_s2 = C_Alternative_s2 { + inv_Alternative_s2 :: (T_Alternative_v1 ) + } +data T_Alternative_s3 = C_Alternative_s3 +type T_Alternative_v1 = (T_Alternative_vIn1 ) -> (T_Alternative_vOut1 ) +data T_Alternative_vIn1 = T_Alternative_vIn1 +data T_Alternative_vOut1 = T_Alternative_vOut1 (Alternative) +{-# NOINLINE sem_Alternative_Hole #-} +sem_Alternative_Hole :: T_Range -> (Integer) -> T_Alternative +sem_Alternative_Hole arg_range_ arg_id_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule0 _rangeIself arg_id_ + _lhsOself :: Alternative + _lhsOself = rule1 _self + __result_ = T_Alternative_vOut1 _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule0 #-} + rule0 = \ ((_rangeIself) :: Range) id_ -> + Alternative_Hole _rangeIself id_ + {-# INLINE rule1 #-} + rule1 = \ _self -> + _self +{-# NOINLINE sem_Alternative_Feedback #-} +sem_Alternative_Feedback :: T_Range -> (String) -> T_Alternative -> T_Alternative +sem_Alternative_Feedback arg_range_ arg_feedback_ arg_alternative_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _alternativeX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_alternative_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Alternative_vOut1 _alternativeIself) = inv_Alternative_s2 _alternativeX2 (T_Alternative_vIn1 ) + _self = rule2 _alternativeIself _rangeIself arg_feedback_ + _lhsOself :: Alternative + _lhsOself = rule3 _self + __result_ = T_Alternative_vOut1 _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule2 #-} + rule2 = \ ((_alternativeIself) :: Alternative) ((_rangeIself) :: Range) feedback_ -> + Alternative_Feedback _rangeIself feedback_ _alternativeIself + {-# INLINE rule3 #-} + rule3 = \ _self -> + _self +{-# NOINLINE sem_Alternative_Alternative #-} +sem_Alternative_Alternative :: T_Range -> T_Pattern -> T_RightHandSide -> T_Alternative +sem_Alternative_Alternative arg_range_ arg_pattern_ arg_righthandside_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX152 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Pattern_vOut121 _patternIself) = inv_Pattern_s122 _patternX122 (T_Pattern_vIn121 ) + (T_RightHandSide_vOut151 _righthandsideIself) = inv_RightHandSide_s152 _righthandsideX152 (T_RightHandSide_vIn151 ) + _self = rule4 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Alternative + _lhsOself = rule5 _self + __result_ = T_Alternative_vOut1 _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule4 #-} + rule4 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Alternative_Alternative _rangeIself _patternIself _righthandsideIself + {-# INLINE rule5 #-} + rule5 = \ _self -> + _self +{-# NOINLINE sem_Alternative_Empty #-} +sem_Alternative_Empty :: T_Range -> T_Alternative +sem_Alternative_Empty arg_range_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule6 _rangeIself + _lhsOself :: Alternative + _lhsOself = rule7 _self + __result_ = T_Alternative_vOut1 _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule6 #-} + rule6 = \ ((_rangeIself) :: Range) -> + Alternative_Empty _rangeIself + {-# INLINE rule7 #-} + rule7 = \ _self -> + _self + +-- Alternatives ------------------------------------------------ +-- wrapper +data Inh_Alternatives = Inh_Alternatives { } +data Syn_Alternatives = Syn_Alternatives { self_Syn_Alternatives :: (Alternatives) } +{-# INLINABLE wrap_Alternatives #-} +wrap_Alternatives :: T_Alternatives -> Inh_Alternatives -> (Syn_Alternatives ) +wrap_Alternatives (T_Alternatives act) (Inh_Alternatives ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternatives_vIn4 + (T_Alternatives_vOut4 _lhsOself) <- return (inv_Alternatives_s5 sem arg) + return (Syn_Alternatives _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternatives #-} +sem_Alternatives :: Alternatives -> T_Alternatives +sem_Alternatives list = Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) + +-- semantic domain +newtype T_Alternatives = T_Alternatives { + attach_T_Alternatives :: Identity (T_Alternatives_s5 ) + } +newtype T_Alternatives_s5 = C_Alternatives_s5 { + inv_Alternatives_s5 :: (T_Alternatives_v4 ) + } +data T_Alternatives_s6 = C_Alternatives_s6 +type T_Alternatives_v4 = (T_Alternatives_vIn4 ) -> (T_Alternatives_vOut4 ) +data T_Alternatives_vIn4 = T_Alternatives_vIn4 +data T_Alternatives_vOut4 = T_Alternatives_vOut4 (Alternatives) +{-# NOINLINE sem_Alternatives_Cons #-} +sem_Alternatives_Cons :: T_Alternative -> T_Alternatives -> T_Alternatives +sem_Alternatives_Cons arg_hd_ arg_tl_ = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 ) -> ( let + _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_hd_)) + _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_tl_)) + (T_Alternative_vOut1 _hdIself) = inv_Alternative_s2 _hdX2 (T_Alternative_vIn1 ) + (T_Alternatives_vOut4 _tlIself) = inv_Alternatives_s5 _tlX5 (T_Alternatives_vIn4 ) + _self = rule8 _hdIself _tlIself + _lhsOself :: Alternatives + _lhsOself = rule9 _self + __result_ = T_Alternatives_vOut4 _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule8 #-} + rule8 = \ ((_hdIself) :: Alternative) ((_tlIself) :: Alternatives) -> + (:) _hdIself _tlIself + {-# INLINE rule9 #-} + rule9 = \ _self -> + _self +{-# NOINLINE sem_Alternatives_Nil #-} +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 ) -> ( let + _self = rule10 () + _lhsOself :: Alternatives + _lhsOself = rule11 _self + __result_ = T_Alternatives_vOut4 _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule10 #-} + rule10 = \ (_ :: ()) -> + [] + {-# INLINE rule11 #-} + rule11 = \ _self -> + _self + +-- AnnotatedType ----------------------------------------------- +-- wrapper +data Inh_AnnotatedType = Inh_AnnotatedType { } +data Syn_AnnotatedType = Syn_AnnotatedType { self_Syn_AnnotatedType :: (AnnotatedType) } +{-# INLINABLE wrap_AnnotatedType #-} +wrap_AnnotatedType :: T_AnnotatedType -> Inh_AnnotatedType -> (Syn_AnnotatedType ) +wrap_AnnotatedType (T_AnnotatedType act) (Inh_AnnotatedType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedType_vIn7 + (T_AnnotatedType_vOut7 _lhsOself) <- return (inv_AnnotatedType_s8 sem arg) + return (Syn_AnnotatedType _lhsOself) + ) + +-- cata +{-# INLINE sem_AnnotatedType #-} +sem_AnnotatedType :: AnnotatedType -> T_AnnotatedType +sem_AnnotatedType ( AnnotatedType_AnnotatedType range_ strict_ type_ ) = sem_AnnotatedType_AnnotatedType ( sem_Range range_ ) strict_ ( sem_Type type_ ) + +-- semantic domain +newtype T_AnnotatedType = T_AnnotatedType { + attach_T_AnnotatedType :: Identity (T_AnnotatedType_s8 ) + } +newtype T_AnnotatedType_s8 = C_AnnotatedType_s8 { + inv_AnnotatedType_s8 :: (T_AnnotatedType_v7 ) + } +data T_AnnotatedType_s9 = C_AnnotatedType_s9 +type T_AnnotatedType_v7 = (T_AnnotatedType_vIn7 ) -> (T_AnnotatedType_vOut7 ) +data T_AnnotatedType_vIn7 = T_AnnotatedType_vIn7 +data T_AnnotatedType_vOut7 = T_AnnotatedType_vOut7 (AnnotatedType) +{-# NOINLINE sem_AnnotatedType_AnnotatedType #-} +sem_AnnotatedType_AnnotatedType :: T_Range -> (Bool) -> T_Type -> T_AnnotatedType +sem_AnnotatedType_AnnotatedType arg_range_ arg_strict_ arg_type_ = T_AnnotatedType (return st8) where + {-# NOINLINE st8 #-} + st8 = let + v7 :: T_AnnotatedType_v7 + v7 = \ (T_AnnotatedType_vIn7 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Type_vOut172 _typeIself _typeItypevariables) = inv_Type_s173 _typeX173 (T_Type_vIn172 ) + _self = rule12 _rangeIself _typeIself arg_strict_ + _lhsOself :: AnnotatedType + _lhsOself = rule13 _self + __result_ = T_AnnotatedType_vOut7 _lhsOself + in __result_ ) + in C_AnnotatedType_s8 v7 + {-# INLINE rule12 #-} + rule12 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) strict_ -> + AnnotatedType_AnnotatedType _rangeIself strict_ _typeIself + {-# INLINE rule13 #-} + rule13 = \ _self -> + _self + +-- AnnotatedTypes ---------------------------------------------- +-- wrapper +data Inh_AnnotatedTypes = Inh_AnnotatedTypes { } +data Syn_AnnotatedTypes = Syn_AnnotatedTypes { self_Syn_AnnotatedTypes :: (AnnotatedTypes) } +{-# INLINABLE wrap_AnnotatedTypes #-} +wrap_AnnotatedTypes :: T_AnnotatedTypes -> Inh_AnnotatedTypes -> (Syn_AnnotatedTypes ) +wrap_AnnotatedTypes (T_AnnotatedTypes act) (Inh_AnnotatedTypes ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedTypes_vIn10 + (T_AnnotatedTypes_vOut10 _lhsOself) <- return (inv_AnnotatedTypes_s11 sem arg) + return (Syn_AnnotatedTypes _lhsOself) + ) + +-- cata +{-# NOINLINE sem_AnnotatedTypes #-} +sem_AnnotatedTypes :: AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes list = Prelude.foldr sem_AnnotatedTypes_Cons sem_AnnotatedTypes_Nil (Prelude.map sem_AnnotatedType list) + +-- semantic domain +newtype T_AnnotatedTypes = T_AnnotatedTypes { + attach_T_AnnotatedTypes :: Identity (T_AnnotatedTypes_s11 ) + } +newtype T_AnnotatedTypes_s11 = C_AnnotatedTypes_s11 { + inv_AnnotatedTypes_s11 :: (T_AnnotatedTypes_v10 ) + } +data T_AnnotatedTypes_s12 = C_AnnotatedTypes_s12 +type T_AnnotatedTypes_v10 = (T_AnnotatedTypes_vIn10 ) -> (T_AnnotatedTypes_vOut10 ) +data T_AnnotatedTypes_vIn10 = T_AnnotatedTypes_vIn10 +data T_AnnotatedTypes_vOut10 = T_AnnotatedTypes_vOut10 (AnnotatedTypes) +{-# NOINLINE sem_AnnotatedTypes_Cons #-} +sem_AnnotatedTypes_Cons :: T_AnnotatedType -> T_AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes_Cons arg_hd_ arg_tl_ = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _hdX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_hd_)) + _tlX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_tl_)) + (T_AnnotatedType_vOut7 _hdIself) = inv_AnnotatedType_s8 _hdX8 (T_AnnotatedType_vIn7 ) + (T_AnnotatedTypes_vOut10 _tlIself) = inv_AnnotatedTypes_s11 _tlX11 (T_AnnotatedTypes_vIn10 ) + _self = rule14 _hdIself _tlIself + _lhsOself :: AnnotatedTypes + _lhsOself = rule15 _self + __result_ = T_AnnotatedTypes_vOut10 _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule14 #-} + rule14 = \ ((_hdIself) :: AnnotatedType) ((_tlIself) :: AnnotatedTypes) -> + (:) _hdIself _tlIself + {-# INLINE rule15 #-} + rule15 = \ _self -> + _self +{-# NOINLINE sem_AnnotatedTypes_Nil #-} +sem_AnnotatedTypes_Nil :: T_AnnotatedTypes +sem_AnnotatedTypes_Nil = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _self = rule16 () + _lhsOself :: AnnotatedTypes + _lhsOself = rule17 _self + __result_ = T_AnnotatedTypes_vOut10 _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule16 #-} + rule16 = \ (_ :: ()) -> + [] + {-# INLINE rule17 #-} + rule17 = \ _self -> + _self + +-- Body -------------------------------------------------------- +-- wrapper +data Inh_Body = Inh_Body { } +data Syn_Body = Syn_Body { self_Syn_Body :: (Body) } +{-# INLINABLE wrap_Body #-} +wrap_Body :: T_Body -> Inh_Body -> (Syn_Body ) +wrap_Body (T_Body act) (Inh_Body ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Body_vIn13 + (T_Body_vOut13 _lhsOself) <- return (inv_Body_s14 sem arg) + return (Syn_Body _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Body #-} +sem_Body :: Body -> T_Body +sem_Body ( Body_Hole range_ id_ ) = sem_Body_Hole ( sem_Range range_ ) id_ +sem_Body ( Body_Body range_ importdeclarations_ declarations_ ) = sem_Body_Body ( sem_Range range_ ) ( sem_ImportDeclarations importdeclarations_ ) ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_Body = T_Body { + attach_T_Body :: Identity (T_Body_s14 ) + } +newtype T_Body_s14 = C_Body_s14 { + inv_Body_s14 :: (T_Body_v13 ) + } +data T_Body_s15 = C_Body_s15 +type T_Body_v13 = (T_Body_vIn13 ) -> (T_Body_vOut13 ) +data T_Body_vIn13 = T_Body_vIn13 +data T_Body_vOut13 = T_Body_vOut13 (Body) +{-# NOINLINE sem_Body_Hole #-} +sem_Body_Hole :: T_Range -> (Integer) -> T_Body +sem_Body_Hole arg_range_ arg_id_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule18 _rangeIself arg_id_ + _lhsOself :: Body + _lhsOself = rule19 _self + __result_ = T_Body_vOut13 _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule18 #-} + rule18 = \ ((_rangeIself) :: Range) id_ -> + Body_Hole _rangeIself id_ + {-# INLINE rule19 #-} + rule19 = \ _self -> + _self +{-# NOINLINE sem_Body_Body #-} +sem_Body_Body :: T_Range -> T_ImportDeclarations -> T_Declarations -> T_Body +sem_Body_Body arg_range_ arg_importdeclarations_ arg_declarations_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importdeclarationsX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_importdeclarations_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_ImportDeclarations_vOut73 _importdeclarationsIself) = inv_ImportDeclarations_s74 _importdeclarationsX74 (T_ImportDeclarations_vIn73 ) + (T_Declarations_vOut31 _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _self = rule20 _declarationsIself _importdeclarationsIself _rangeIself + _lhsOself :: Body + _lhsOself = rule21 _self + __result_ = T_Body_vOut13 _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule20 #-} + rule20 = \ ((_declarationsIself) :: Declarations) ((_importdeclarationsIself) :: ImportDeclarations) ((_rangeIself) :: Range) -> + Body_Body _rangeIself _importdeclarationsIself _declarationsIself + {-# INLINE rule21 #-} + rule21 = \ _self -> + _self + +-- Constructor ------------------------------------------------- +-- wrapper +data Inh_Constructor = Inh_Constructor { } +data Syn_Constructor = Syn_Constructor { self_Syn_Constructor :: (Constructor) } +{-# INLINABLE wrap_Constructor #-} +wrap_Constructor :: T_Constructor -> Inh_Constructor -> (Syn_Constructor ) +wrap_Constructor (T_Constructor act) (Inh_Constructor ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructor_vIn16 + (T_Constructor_vOut16 _lhsOself) <- return (inv_Constructor_s17 sem arg) + return (Syn_Constructor _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructor #-} +sem_Constructor :: Constructor -> T_Constructor +sem_Constructor ( Constructor_Constructor range_ constructor_ types_ ) = sem_Constructor_Constructor ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_AnnotatedTypes types_ ) +sem_Constructor ( Constructor_Infix range_ leftType_ constructorOperator_ rightType_ ) = sem_Constructor_Infix ( sem_Range range_ ) ( sem_AnnotatedType leftType_ ) ( sem_Name constructorOperator_ ) ( sem_AnnotatedType rightType_ ) +sem_Constructor ( Constructor_Record range_ constructor_ fieldDeclarations_ ) = sem_Constructor_Record ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_FieldDeclarations fieldDeclarations_ ) + +-- semantic domain +newtype T_Constructor = T_Constructor { + attach_T_Constructor :: Identity (T_Constructor_s17 ) + } +newtype T_Constructor_s17 = C_Constructor_s17 { + inv_Constructor_s17 :: (T_Constructor_v16 ) + } +data T_Constructor_s18 = C_Constructor_s18 +type T_Constructor_v16 = (T_Constructor_vIn16 ) -> (T_Constructor_vOut16 ) +data T_Constructor_vIn16 = T_Constructor_vIn16 +data T_Constructor_vOut16 = T_Constructor_vOut16 (Constructor) +{-# NOINLINE sem_Constructor_Constructor #-} +sem_Constructor_Constructor :: T_Range -> T_Name -> T_AnnotatedTypes -> T_Constructor +sem_Constructor_Constructor arg_range_ arg_constructor_ arg_types_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _typesX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_types_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _constructorIself) = inv_Name_s116 _constructorX116 (T_Name_vIn115 ) + (T_AnnotatedTypes_vOut10 _typesIself) = inv_AnnotatedTypes_s11 _typesX11 (T_AnnotatedTypes_vIn10 ) + _self = rule22 _constructorIself _rangeIself _typesIself + _lhsOself :: Constructor + _lhsOself = rule23 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule22 #-} + rule22 = \ ((_constructorIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: AnnotatedTypes) -> + Constructor_Constructor _rangeIself _constructorIself _typesIself + {-# INLINE rule23 #-} + rule23 = \ _self -> + _self +{-# NOINLINE sem_Constructor_Infix #-} +sem_Constructor_Infix :: T_Range -> T_AnnotatedType -> T_Name -> T_AnnotatedType -> T_Constructor +sem_Constructor_Infix arg_range_ arg_leftType_ arg_constructorOperator_ arg_rightType_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_leftType_)) + _constructorOperatorX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_rightType_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_AnnotatedType_vOut7 _leftTypeIself) = inv_AnnotatedType_s8 _leftTypeX8 (T_AnnotatedType_vIn7 ) + (T_Name_vOut115 _constructorOperatorIself) = inv_Name_s116 _constructorOperatorX116 (T_Name_vIn115 ) + (T_AnnotatedType_vOut7 _rightTypeIself) = inv_AnnotatedType_s8 _rightTypeX8 (T_AnnotatedType_vIn7 ) + _self = rule24 _constructorOperatorIself _leftTypeIself _rangeIself _rightTypeIself + _lhsOself :: Constructor + _lhsOself = rule25 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule24 #-} + rule24 = \ ((_constructorOperatorIself) :: Name) ((_leftTypeIself) :: AnnotatedType) ((_rangeIself) :: Range) ((_rightTypeIself) :: AnnotatedType) -> + Constructor_Infix _rangeIself _leftTypeIself _constructorOperatorIself _rightTypeIself + {-# INLINE rule25 #-} + rule25 = \ _self -> + _self +{-# NOINLINE sem_Constructor_Record #-} +sem_Constructor_Record :: T_Range -> T_Name -> T_FieldDeclarations -> T_Constructor +sem_Constructor_Record arg_range_ arg_constructor_ arg_fieldDeclarations_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _fieldDeclarationsX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_fieldDeclarations_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _constructorIself) = inv_Name_s116 _constructorX116 (T_Name_vIn115 ) + (T_FieldDeclarations_vOut49 _fieldDeclarationsIself) = inv_FieldDeclarations_s50 _fieldDeclarationsX50 (T_FieldDeclarations_vIn49 ) + _self = rule26 _constructorIself _fieldDeclarationsIself _rangeIself + _lhsOself :: Constructor + _lhsOself = rule27 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule26 #-} + rule26 = \ ((_constructorIself) :: Name) ((_fieldDeclarationsIself) :: FieldDeclarations) ((_rangeIself) :: Range) -> + Constructor_Record _rangeIself _constructorIself _fieldDeclarationsIself + {-# INLINE rule27 #-} + rule27 = \ _self -> + _self + +-- Constructors ------------------------------------------------ +-- wrapper +data Inh_Constructors = Inh_Constructors { } +data Syn_Constructors = Syn_Constructors { self_Syn_Constructors :: (Constructors) } +{-# INLINABLE wrap_Constructors #-} +wrap_Constructors :: T_Constructors -> Inh_Constructors -> (Syn_Constructors ) +wrap_Constructors (T_Constructors act) (Inh_Constructors ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructors_vIn19 + (T_Constructors_vOut19 _lhsOself) <- return (inv_Constructors_s20 sem arg) + return (Syn_Constructors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructors #-} +sem_Constructors :: Constructors -> T_Constructors +sem_Constructors list = Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list) + +-- semantic domain +newtype T_Constructors = T_Constructors { + attach_T_Constructors :: Identity (T_Constructors_s20 ) + } +newtype T_Constructors_s20 = C_Constructors_s20 { + inv_Constructors_s20 :: (T_Constructors_v19 ) + } +data T_Constructors_s21 = C_Constructors_s21 +type T_Constructors_v19 = (T_Constructors_vIn19 ) -> (T_Constructors_vOut19 ) +data T_Constructors_vIn19 = T_Constructors_vIn19 +data T_Constructors_vOut19 = T_Constructors_vOut19 (Constructors) +{-# NOINLINE sem_Constructors_Cons #-} +sem_Constructors_Cons :: T_Constructor -> T_Constructors -> T_Constructors +sem_Constructors_Cons arg_hd_ arg_tl_ = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 ) -> ( let + _hdX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_hd_)) + _tlX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_tl_)) + (T_Constructor_vOut16 _hdIself) = inv_Constructor_s17 _hdX17 (T_Constructor_vIn16 ) + (T_Constructors_vOut19 _tlIself) = inv_Constructors_s20 _tlX20 (T_Constructors_vIn19 ) + _self = rule28 _hdIself _tlIself + _lhsOself :: Constructors + _lhsOself = rule29 _self + __result_ = T_Constructors_vOut19 _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule28 #-} + rule28 = \ ((_hdIself) :: Constructor) ((_tlIself) :: Constructors) -> + (:) _hdIself _tlIself + {-# INLINE rule29 #-} + rule29 = \ _self -> + _self +{-# NOINLINE sem_Constructors_Nil #-} +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 ) -> ( let + _self = rule30 () + _lhsOself :: Constructors + _lhsOself = rule31 _self + __result_ = T_Constructors_vOut19 _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule30 #-} + rule30 = \ (_ :: ()) -> + [] + {-# INLINE rule31 #-} + rule31 = \ _self -> + _self + +-- ContextItem ------------------------------------------------- +-- wrapper +data Inh_ContextItem = Inh_ContextItem { } +data Syn_ContextItem = Syn_ContextItem { self_Syn_ContextItem :: (ContextItem) } +{-# INLINABLE wrap_ContextItem #-} +wrap_ContextItem :: T_ContextItem -> Inh_ContextItem -> (Syn_ContextItem ) +wrap_ContextItem (T_ContextItem act) (Inh_ContextItem ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItem_vIn22 + (T_ContextItem_vOut22 _lhsOself) <- return (inv_ContextItem_s23 sem arg) + return (Syn_ContextItem _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItem #-} +sem_ContextItem :: ContextItem -> T_ContextItem +sem_ContextItem ( ContextItem_ContextItem range_ name_ types_ ) = sem_ContextItem_ContextItem ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Types types_ ) + +-- semantic domain +newtype T_ContextItem = T_ContextItem { + attach_T_ContextItem :: Identity (T_ContextItem_s23 ) + } +newtype T_ContextItem_s23 = C_ContextItem_s23 { + inv_ContextItem_s23 :: (T_ContextItem_v22 ) + } +data T_ContextItem_s24 = C_ContextItem_s24 +type T_ContextItem_v22 = (T_ContextItem_vIn22 ) -> (T_ContextItem_vOut22 ) +data T_ContextItem_vIn22 = T_ContextItem_vIn22 +data T_ContextItem_vOut22 = T_ContextItem_vOut22 (ContextItem) +{-# NOINLINE sem_ContextItem_ContextItem #-} +sem_ContextItem_ContextItem :: T_Range -> T_Name -> T_Types -> T_ContextItem +sem_ContextItem_ContextItem arg_range_ arg_name_ arg_types_ = T_ContextItem (return st23) where + {-# NOINLINE st23 #-} + st23 = let + v22 :: T_ContextItem_v22 + v22 = \ (T_ContextItem_vIn22 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX179 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_Types_vOut178 _typesIself _typesItypevariables) = inv_Types_s179 _typesX179 (T_Types_vIn178 ) + _self = rule32 _nameIself _rangeIself _typesIself + _lhsOself :: ContextItem + _lhsOself = rule33 _self + __result_ = T_ContextItem_vOut22 _lhsOself + in __result_ ) + in C_ContextItem_s23 v22 + {-# INLINE rule32 #-} + rule32 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + ContextItem_ContextItem _rangeIself _nameIself _typesIself + {-# INLINE rule33 #-} + rule33 = \ _self -> + _self + +-- ContextItems ------------------------------------------------ +-- wrapper +data Inh_ContextItems = Inh_ContextItems { } +data Syn_ContextItems = Syn_ContextItems { self_Syn_ContextItems :: (ContextItems) } +{-# INLINABLE wrap_ContextItems #-} +wrap_ContextItems :: T_ContextItems -> Inh_ContextItems -> (Syn_ContextItems ) +wrap_ContextItems (T_ContextItems act) (Inh_ContextItems ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItems_vIn25 + (T_ContextItems_vOut25 _lhsOself) <- return (inv_ContextItems_s26 sem arg) + return (Syn_ContextItems _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItems #-} +sem_ContextItems :: ContextItems -> T_ContextItems +sem_ContextItems list = Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list) + +-- semantic domain +newtype T_ContextItems = T_ContextItems { + attach_T_ContextItems :: Identity (T_ContextItems_s26 ) + } +newtype T_ContextItems_s26 = C_ContextItems_s26 { + inv_ContextItems_s26 :: (T_ContextItems_v25 ) + } +data T_ContextItems_s27 = C_ContextItems_s27 +type T_ContextItems_v25 = (T_ContextItems_vIn25 ) -> (T_ContextItems_vOut25 ) +data T_ContextItems_vIn25 = T_ContextItems_vIn25 +data T_ContextItems_vOut25 = T_ContextItems_vOut25 (ContextItems) +{-# NOINLINE sem_ContextItems_Cons #-} +sem_ContextItems_Cons :: T_ContextItem -> T_ContextItems -> T_ContextItems +sem_ContextItems_Cons arg_hd_ arg_tl_ = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _hdX23 = Control.Monad.Identity.runIdentity (attach_T_ContextItem (arg_hd_)) + _tlX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_tl_)) + (T_ContextItem_vOut22 _hdIself) = inv_ContextItem_s23 _hdX23 (T_ContextItem_vIn22 ) + (T_ContextItems_vOut25 _tlIself) = inv_ContextItems_s26 _tlX26 (T_ContextItems_vIn25 ) + _self = rule34 _hdIself _tlIself + _lhsOself :: ContextItems + _lhsOself = rule35 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule34 #-} + rule34 = \ ((_hdIself) :: ContextItem) ((_tlIself) :: ContextItems) -> + (:) _hdIself _tlIself + {-# INLINE rule35 #-} + rule35 = \ _self -> + _self +{-# NOINLINE sem_ContextItems_Nil #-} +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _self = rule36 () + _lhsOself :: ContextItems + _lhsOself = rule37 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule36 #-} + rule36 = \ (_ :: ()) -> + [] + {-# INLINE rule37 #-} + rule37 = \ _self -> + _self + +-- Declaration ------------------------------------------------- +-- wrapper +data Inh_Declaration = Inh_Declaration { } +data Syn_Declaration = Syn_Declaration { self_Syn_Declaration :: (Declaration) } +{-# INLINABLE wrap_Declaration #-} +wrap_Declaration :: T_Declaration -> Inh_Declaration -> (Syn_Declaration ) +wrap_Declaration (T_Declaration act) (Inh_Declaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declaration_vIn28 + (T_Declaration_vOut28 _lhsOself) <- return (inv_Declaration_s29 sem arg) + return (Syn_Declaration _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declaration #-} +sem_Declaration :: Declaration -> T_Declaration +sem_Declaration ( Declaration_Hole range_ id_ ) = sem_Declaration_Hole ( sem_Range range_ ) id_ +sem_Declaration ( Declaration_Type range_ simpletype_ type_ ) = sem_Declaration_Type ( sem_Range range_ ) ( sem_SimpleType simpletype_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Data range_ context_ simpletype_ constructors_ derivings_ ) = sem_Declaration_Data ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructors constructors_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Newtype range_ context_ simpletype_ constructor_ derivings_ ) = sem_Declaration_Newtype ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructor constructor_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Class range_ context_ simpletype_ where_ ) = sem_Declaration_Class ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Instance range_ context_ name_ types_ where_ ) = sem_Declaration_Instance ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Name name_ ) ( sem_Types types_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Default range_ types_ ) = sem_Declaration_Default ( sem_Range range_ ) ( sem_Types types_ ) +sem_Declaration ( Declaration_FunctionBindings range_ bindings_ ) = sem_Declaration_FunctionBindings ( sem_Range range_ ) ( sem_FunctionBindings bindings_ ) +sem_Declaration ( Declaration_PatternBinding range_ pattern_ righthandside_ ) = sem_Declaration_PatternBinding ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Declaration ( Declaration_TypeSignature range_ names_ type_ ) = sem_Declaration_TypeSignature ( sem_Range range_ ) ( sem_Names names_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Fixity range_ fixity_ priority_ operators_ ) = sem_Declaration_Fixity ( sem_Range range_ ) ( sem_Fixity fixity_ ) ( sem_MaybeInt priority_ ) ( sem_Names operators_ ) +sem_Declaration ( Declaration_Empty range_ ) = sem_Declaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Declaration = T_Declaration { + attach_T_Declaration :: Identity (T_Declaration_s29 ) + } +newtype T_Declaration_s29 = C_Declaration_s29 { + inv_Declaration_s29 :: (T_Declaration_v28 ) + } +data T_Declaration_s30 = C_Declaration_s30 +type T_Declaration_v28 = (T_Declaration_vIn28 ) -> (T_Declaration_vOut28 ) +data T_Declaration_vIn28 = T_Declaration_vIn28 +data T_Declaration_vOut28 = T_Declaration_vOut28 (Declaration) +{-# NOINLINE sem_Declaration_Hole #-} +sem_Declaration_Hole :: T_Range -> (Integer) -> T_Declaration +sem_Declaration_Hole arg_range_ arg_id_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule38 _rangeIself arg_id_ + _lhsOself :: Declaration + _lhsOself = rule39 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule38 #-} + rule38 = \ ((_rangeIself) :: Range) id_ -> + Declaration_Hole _rangeIself id_ + {-# INLINE rule39 #-} + rule39 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Type #-} +sem_Declaration_Type :: T_Range -> T_SimpleType -> T_Type -> T_Declaration +sem_Declaration_Type arg_range_ arg_simpletype_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _simpletypeX161 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _typeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_SimpleType_vOut160 _simpletypeIself) = inv_SimpleType_s161 _simpletypeX161 (T_SimpleType_vIn160 ) + (T_Type_vOut172 _typeIself _typeItypevariables) = inv_Type_s173 _typeX173 (T_Type_vIn172 ) + _self = rule40 _rangeIself _simpletypeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule41 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule40 #-} + rule40 = \ ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_typeIself) :: Type) -> + Declaration_Type _rangeIself _simpletypeIself _typeIself + {-# INLINE rule41 #-} + rule41 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Data #-} +sem_Declaration_Data :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructors -> T_Names -> T_Declaration +sem_Declaration_Data arg_range_ arg_context_ arg_simpletype_ arg_constructors_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX161 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorsX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_constructors_)) + _derivingsX119 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut160 _simpletypeIself) = inv_SimpleType_s161 _simpletypeX161 (T_SimpleType_vIn160 ) + (T_Constructors_vOut19 _constructorsIself) = inv_Constructors_s20 _constructorsX20 (T_Constructors_vIn19 ) + (T_Names_vOut118 _derivingsIself) = inv_Names_s119 _derivingsX119 (T_Names_vIn118 ) + _self = rule42 _constructorsIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule43 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule42 #-} + rule42 = \ ((_constructorsIself) :: Constructors) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Data _rangeIself _contextIself _simpletypeIself _constructorsIself _derivingsIself + {-# INLINE rule43 #-} + rule43 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Newtype #-} +sem_Declaration_Newtype :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructor -> T_Names -> T_Declaration +sem_Declaration_Newtype arg_range_ arg_context_ arg_simpletype_ arg_constructor_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX161 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_constructor_)) + _derivingsX119 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut160 _simpletypeIself) = inv_SimpleType_s161 _simpletypeX161 (T_SimpleType_vIn160 ) + (T_Constructor_vOut16 _constructorIself) = inv_Constructor_s17 _constructorX17 (T_Constructor_vIn16 ) + (T_Names_vOut118 _derivingsIself) = inv_Names_s119 _derivingsX119 (T_Names_vIn118 ) + _self = rule44 _constructorIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule45 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule44 #-} + rule44 = \ ((_constructorIself) :: Constructor) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Newtype _rangeIself _contextIself _simpletypeIself _constructorIself _derivingsIself + {-# INLINE rule45 #-} + rule45 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Class #-} +sem_Declaration_Class :: T_Range -> T_ContextItems -> T_SimpleType -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Class arg_range_ arg_context_ arg_simpletype_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX161 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _whereX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut160 _simpletypeIself) = inv_SimpleType_s161 _simpletypeX161 (T_SimpleType_vIn160 ) + (T_MaybeDeclarations_vOut91 _whereIself) = inv_MaybeDeclarations_s92 _whereX92 (T_MaybeDeclarations_vIn91 ) + _self = rule46 _contextIself _rangeIself _simpletypeIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule47 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule46 #-} + rule46 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Class _rangeIself _contextIself _simpletypeIself _whereIself + {-# INLINE rule47 #-} + rule47 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Instance #-} +sem_Declaration_Instance :: T_Range -> T_ContextItems -> T_Name -> T_Types -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Instance arg_range_ arg_context_ arg_name_ arg_types_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX179 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + _whereX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_Types_vOut178 _typesIself _typesItypevariables) = inv_Types_s179 _typesX179 (T_Types_vIn178 ) + (T_MaybeDeclarations_vOut91 _whereIself) = inv_MaybeDeclarations_s92 _whereX92 (T_MaybeDeclarations_vIn91 ) + _self = rule48 _contextIself _nameIself _rangeIself _typesIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule49 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule48 #-} + rule48 = \ ((_contextIself) :: ContextItems) ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Instance _rangeIself _contextIself _nameIself _typesIself _whereIself + {-# INLINE rule49 #-} + rule49 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Default #-} +sem_Declaration_Default :: T_Range -> T_Types -> T_Declaration +sem_Declaration_Default arg_range_ arg_types_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typesX179 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Types_vOut178 _typesIself _typesItypevariables) = inv_Types_s179 _typesX179 (T_Types_vIn178 ) + _self = rule50 _rangeIself _typesIself + _lhsOself :: Declaration + _lhsOself = rule51 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule50 #-} + rule50 = \ ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + Declaration_Default _rangeIself _typesIself + {-# INLINE rule51 #-} + rule51 = \ _self -> + _self +{-# NOINLINE sem_Declaration_FunctionBindings #-} +sem_Declaration_FunctionBindings :: T_Range -> T_FunctionBindings -> T_Declaration +sem_Declaration_FunctionBindings arg_range_ arg_bindings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _bindingsX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_bindings_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_FunctionBindings_vOut58 _bindingsIself) = inv_FunctionBindings_s59 _bindingsX59 (T_FunctionBindings_vIn58 ) + _self = rule52 _bindingsIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule53 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule52 #-} + rule52 = \ ((_bindingsIself) :: FunctionBindings) ((_rangeIself) :: Range) -> + Declaration_FunctionBindings _rangeIself _bindingsIself + {-# INLINE rule53 #-} + rule53 = \ _self -> + _self +{-# NOINLINE sem_Declaration_PatternBinding #-} +sem_Declaration_PatternBinding :: T_Range -> T_Pattern -> T_RightHandSide -> T_Declaration +sem_Declaration_PatternBinding arg_range_ arg_pattern_ arg_righthandside_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX152 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Pattern_vOut121 _patternIself) = inv_Pattern_s122 _patternX122 (T_Pattern_vIn121 ) + (T_RightHandSide_vOut151 _righthandsideIself) = inv_RightHandSide_s152 _righthandsideX152 (T_RightHandSide_vIn151 ) + _self = rule54 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Declaration + _lhsOself = rule55 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule54 #-} + rule54 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Declaration_PatternBinding _rangeIself _patternIself _righthandsideIself + {-# INLINE rule55 #-} + rule55 = \ _self -> + _self +{-# NOINLINE sem_Declaration_TypeSignature #-} +sem_Declaration_TypeSignature :: T_Range -> T_Names -> T_Type -> T_Declaration +sem_Declaration_TypeSignature arg_range_ arg_names_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX119 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Names_vOut118 _namesIself) = inv_Names_s119 _namesX119 (T_Names_vIn118 ) + (T_Type_vOut172 _typeIself _typeItypevariables) = inv_Type_s173 _typeX173 (T_Type_vIn172 ) + _self = rule56 _namesIself _rangeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule57 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule56 #-} + rule56 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Declaration_TypeSignature _rangeIself _namesIself _typeIself + {-# INLINE rule57 #-} + rule57 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Fixity #-} +sem_Declaration_Fixity :: T_Range -> T_Fixity -> T_MaybeInt -> T_Names -> T_Declaration +sem_Declaration_Fixity arg_range_ arg_fixity_ arg_priority_ arg_operators_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fixityX53 = Control.Monad.Identity.runIdentity (attach_T_Fixity (arg_fixity_)) + _priorityX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeInt (arg_priority_)) + _operatorsX119 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_operators_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Fixity_vOut52 _fixityIself) = inv_Fixity_s53 _fixityX53 (T_Fixity_vIn52 ) + (T_MaybeInt_vOut103 _priorityIself) = inv_MaybeInt_s104 _priorityX104 (T_MaybeInt_vIn103 ) + (T_Names_vOut118 _operatorsIself) = inv_Names_s119 _operatorsX119 (T_Names_vIn118 ) + _self = rule58 _fixityIself _operatorsIself _priorityIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule59 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule58 #-} + rule58 = \ ((_fixityIself) :: Fixity) ((_operatorsIself) :: Names) ((_priorityIself) :: MaybeInt) ((_rangeIself) :: Range) -> + Declaration_Fixity _rangeIself _fixityIself _priorityIself _operatorsIself + {-# INLINE rule59 #-} + rule59 = \ _self -> + _self +{-# NOINLINE sem_Declaration_Empty #-} +sem_Declaration_Empty :: T_Range -> T_Declaration +sem_Declaration_Empty arg_range_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule60 _rangeIself + _lhsOself :: Declaration + _lhsOself = rule61 _self + __result_ = T_Declaration_vOut28 _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule60 #-} + rule60 = \ ((_rangeIself) :: Range) -> + Declaration_Empty _rangeIself + {-# INLINE rule61 #-} + rule61 = \ _self -> + _self + +-- Declarations ------------------------------------------------ +-- wrapper +data Inh_Declarations = Inh_Declarations { } +data Syn_Declarations = Syn_Declarations { self_Syn_Declarations :: (Declarations) } +{-# INLINABLE wrap_Declarations #-} +wrap_Declarations :: T_Declarations -> Inh_Declarations -> (Syn_Declarations ) +wrap_Declarations (T_Declarations act) (Inh_Declarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declarations_vIn31 + (T_Declarations_vOut31 _lhsOself) <- return (inv_Declarations_s32 sem arg) + return (Syn_Declarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declarations #-} +sem_Declarations :: Declarations -> T_Declarations +sem_Declarations list = Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list) + +-- semantic domain +newtype T_Declarations = T_Declarations { + attach_T_Declarations :: Identity (T_Declarations_s32 ) + } +newtype T_Declarations_s32 = C_Declarations_s32 { + inv_Declarations_s32 :: (T_Declarations_v31 ) + } +data T_Declarations_s33 = C_Declarations_s33 +type T_Declarations_v31 = (T_Declarations_vIn31 ) -> (T_Declarations_vOut31 ) +data T_Declarations_vIn31 = T_Declarations_vIn31 +data T_Declarations_vOut31 = T_Declarations_vOut31 (Declarations) +{-# NOINLINE sem_Declarations_Cons #-} +sem_Declarations_Cons :: T_Declaration -> T_Declarations -> T_Declarations +sem_Declarations_Cons arg_hd_ arg_tl_ = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 ) -> ( let + _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Declaration (arg_hd_)) + _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_tl_)) + (T_Declaration_vOut28 _hdIself) = inv_Declaration_s29 _hdX29 (T_Declaration_vIn28 ) + (T_Declarations_vOut31 _tlIself) = inv_Declarations_s32 _tlX32 (T_Declarations_vIn31 ) + _self = rule62 _hdIself _tlIself + _lhsOself :: Declarations + _lhsOself = rule63 _self + __result_ = T_Declarations_vOut31 _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule62 #-} + rule62 = \ ((_hdIself) :: Declaration) ((_tlIself) :: Declarations) -> + (:) _hdIself _tlIself + {-# INLINE rule63 #-} + rule63 = \ _self -> + _self +{-# NOINLINE sem_Declarations_Nil #-} +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 ) -> ( let + _self = rule64 () + _lhsOself :: Declarations + _lhsOself = rule65 _self + __result_ = T_Declarations_vOut31 _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule64 #-} + rule64 = \ (_ :: ()) -> + [] + {-# INLINE rule65 #-} + rule65 = \ _self -> + _self + +-- Export ------------------------------------------------------ +-- wrapper +data Inh_Export = Inh_Export { } +data Syn_Export = Syn_Export { self_Syn_Export :: (Export) } +{-# INLINABLE wrap_Export #-} +wrap_Export :: T_Export -> Inh_Export -> (Syn_Export ) +wrap_Export (T_Export act) (Inh_Export ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Export_vIn34 + (T_Export_vOut34 _lhsOself) <- return (inv_Export_s35 sem arg) + return (Syn_Export _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Export #-} +sem_Export :: Export -> T_Export +sem_Export ( Export_Variable range_ name_ ) = sem_Export_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_TypeOrClass range_ name_ names_ ) = sem_Export_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Export ( Export_TypeOrClassComplete range_ name_ ) = sem_Export_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_Module range_ name_ ) = sem_Export_Module ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Export = T_Export { + attach_T_Export :: Identity (T_Export_s35 ) + } +newtype T_Export_s35 = C_Export_s35 { + inv_Export_s35 :: (T_Export_v34 ) + } +data T_Export_s36 = C_Export_s36 +type T_Export_v34 = (T_Export_vIn34 ) -> (T_Export_vOut34 ) +data T_Export_vIn34 = T_Export_vIn34 +data T_Export_vOut34 = T_Export_vOut34 (Export) +{-# NOINLINE sem_Export_Variable #-} +sem_Export_Variable :: T_Range -> T_Name -> T_Export +sem_Export_Variable arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _self = rule66 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule67 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule66 #-} + rule66 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Variable _rangeIself _nameIself + {-# INLINE rule67 #-} + rule67 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClass #-} +sem_Export_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Export +sem_Export_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX110 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_MaybeNames_vOut109 _namesIself) = inv_MaybeNames_s110 _namesX110 (T_MaybeNames_vIn109 ) + _self = rule68 _nameIself _namesIself _rangeIself + _lhsOself :: Export + _lhsOself = rule69 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule68 #-} + rule68 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Export_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule69 #-} + rule69 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClassComplete #-} +sem_Export_TypeOrClassComplete :: T_Range -> T_Name -> T_Export +sem_Export_TypeOrClassComplete arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _self = rule70 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule71 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule70 #-} + rule70 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule71 #-} + rule71 = \ _self -> + _self +{-# NOINLINE sem_Export_Module #-} +sem_Export_Module :: T_Range -> T_Name -> T_Export +sem_Export_Module arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _self = rule72 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule73 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule72 #-} + rule72 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Module _rangeIself _nameIself + {-# INLINE rule73 #-} + rule73 = \ _self -> + _self + +-- Exports ----------------------------------------------------- +-- wrapper +data Inh_Exports = Inh_Exports { } +data Syn_Exports = Syn_Exports { self_Syn_Exports :: (Exports) } +{-# INLINABLE wrap_Exports #-} +wrap_Exports :: T_Exports -> Inh_Exports -> (Syn_Exports ) +wrap_Exports (T_Exports act) (Inh_Exports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Exports_vIn37 + (T_Exports_vOut37 _lhsOself) <- return (inv_Exports_s38 sem arg) + return (Syn_Exports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Exports #-} +sem_Exports :: Exports -> T_Exports +sem_Exports list = Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list) + +-- semantic domain +newtype T_Exports = T_Exports { + attach_T_Exports :: Identity (T_Exports_s38 ) + } +newtype T_Exports_s38 = C_Exports_s38 { + inv_Exports_s38 :: (T_Exports_v37 ) + } +data T_Exports_s39 = C_Exports_s39 +type T_Exports_v37 = (T_Exports_vIn37 ) -> (T_Exports_vOut37 ) +data T_Exports_vIn37 = T_Exports_vIn37 +data T_Exports_vOut37 = T_Exports_vOut37 (Exports) +{-# NOINLINE sem_Exports_Cons #-} +sem_Exports_Cons :: T_Export -> T_Exports -> T_Exports +sem_Exports_Cons arg_hd_ arg_tl_ = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Export (arg_hd_)) + _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_tl_)) + (T_Export_vOut34 _hdIself) = inv_Export_s35 _hdX35 (T_Export_vIn34 ) + (T_Exports_vOut37 _tlIself) = inv_Exports_s38 _tlX38 (T_Exports_vIn37 ) + _self = rule74 _hdIself _tlIself + _lhsOself :: Exports + _lhsOself = rule75 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule74 #-} + rule74 = \ ((_hdIself) :: Export) ((_tlIself) :: Exports) -> + (:) _hdIself _tlIself + {-# INLINE rule75 #-} + rule75 = \ _self -> + _self +{-# NOINLINE sem_Exports_Nil #-} +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _self = rule76 () + _lhsOself :: Exports + _lhsOself = rule77 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule76 #-} + rule76 = \ (_ :: ()) -> + [] + {-# INLINE rule77 #-} + rule77 = \ _self -> + _self + +-- Expression -------------------------------------------------- +-- wrapper +data Inh_Expression = Inh_Expression { } +data Syn_Expression = Syn_Expression { allVariables_Syn_Expression :: ([(Name,Entity)]), self_Syn_Expression :: (Expression) } +{-# INLINABLE wrap_Expression #-} +wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) +wrap_Expression (T_Expression act) (Inh_Expression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expression_vIn40 + (T_Expression_vOut40 _lhsOallVariables _lhsOself) <- return (inv_Expression_s41 sem arg) + return (Syn_Expression _lhsOallVariables _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expression #-} +sem_Expression :: Expression -> T_Expression +sem_Expression ( Expression_Hole range_ id_ ) = sem_Expression_Hole ( sem_Range range_ ) id_ +sem_Expression ( Expression_Feedback range_ feedback_ expression_ ) = sem_Expression_Feedback ( sem_Range range_ ) feedback_ ( sem_Expression expression_ ) +sem_Expression ( Expression_MustUse range_ expression_ ) = sem_Expression_MustUse ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Literal range_ literal_ ) = sem_Expression_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Expression ( Expression_Variable range_ name_ ) = sem_Expression_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Constructor range_ name_ ) = sem_Expression_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Parenthesized range_ expression_ ) = sem_Expression_Parenthesized ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NormalApplication range_ function_ arguments_ ) = sem_Expression_NormalApplication ( sem_Range range_ ) ( sem_Expression function_ ) ( sem_Expressions arguments_ ) +sem_Expression ( Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ ) = sem_Expression_InfixApplication ( sem_Range range_ ) ( sem_MaybeExpression leftExpression_ ) ( sem_Expression operator_ ) ( sem_MaybeExpression rightExpression_ ) +sem_Expression ( Expression_If range_ guardExpression_ thenExpression_ elseExpression_ ) = sem_Expression_If ( sem_Range range_ ) ( sem_Expression guardExpression_ ) ( sem_Expression thenExpression_ ) ( sem_Expression elseExpression_ ) +sem_Expression ( Expression_Lambda range_ patterns_ expression_ ) = sem_Expression_Lambda ( sem_Range range_ ) ( sem_Patterns patterns_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Case range_ expression_ alternatives_ ) = sem_Expression_Case ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Alternatives alternatives_ ) +sem_Expression ( Expression_Let range_ declarations_ expression_ ) = sem_Expression_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Do range_ statements_ ) = sem_Expression_Do ( sem_Range range_ ) ( sem_Statements statements_ ) +sem_Expression ( Expression_List range_ expressions_ ) = sem_Expression_List ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Tuple range_ expressions_ ) = sem_Expression_Tuple ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Comprehension range_ expression_ qualifiers_ ) = sem_Expression_Comprehension ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Qualifiers qualifiers_ ) +sem_Expression ( Expression_Typed range_ expression_ type_ ) = sem_Expression_Typed ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Type type_ ) +sem_Expression ( Expression_RecordConstruction range_ name_ recordExpressionBindings_ ) = sem_Expression_RecordConstruction ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_RecordUpdate range_ expression_ recordExpressionBindings_ ) = sem_Expression_RecordUpdate ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_Enum range_ from_ then_ to_ ) = sem_Expression_Enum ( sem_Range range_ ) ( sem_Expression from_ ) ( sem_MaybeExpression then_ ) ( sem_MaybeExpression to_ ) +sem_Expression ( Expression_Negate range_ expression_ ) = sem_Expression_Negate ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NegateFloat range_ expression_ ) = sem_Expression_NegateFloat ( sem_Range range_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_Expression = T_Expression { + attach_T_Expression :: Identity (T_Expression_s41 ) + } +newtype T_Expression_s41 = C_Expression_s41 { + inv_Expression_s41 :: (T_Expression_v40 ) + } +data T_Expression_s42 = C_Expression_s42 +type T_Expression_v40 = (T_Expression_vIn40 ) -> (T_Expression_vOut40 ) +data T_Expression_vIn40 = T_Expression_vIn40 +data T_Expression_vOut40 = T_Expression_vOut40 ([(Name,Entity)]) (Expression) +{-# NOINLINE sem_Expression_Hole #-} +sem_Expression_Hole :: T_Range -> (Integer) -> T_Expression +sem_Expression_Hole arg_range_ arg_id_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule78 () + _self = rule79 _rangeIself arg_id_ + _lhsOself :: Expression + _lhsOself = rule80 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule78 #-} + rule78 = \ (_ :: ()) -> + [] + {-# INLINE rule79 #-} + rule79 = \ ((_rangeIself) :: Range) id_ -> + Expression_Hole _rangeIself id_ + {-# INLINE rule80 #-} + rule80 = \ _self -> + _self +{-# NOINLINE sem_Expression_Feedback #-} +sem_Expression_Feedback :: T_Range -> (String) -> T_Expression -> T_Expression +sem_Expression_Feedback arg_range_ arg_feedback_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule81 _expressionIallVariables + _self = rule82 _expressionIself _rangeIself arg_feedback_ + _lhsOself :: Expression + _lhsOself = rule83 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule81 #-} + rule81 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule82 #-} + rule82 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) feedback_ -> + Expression_Feedback _rangeIself feedback_ _expressionIself + {-# INLINE rule83 #-} + rule83 = \ _self -> + _self +{-# NOINLINE sem_Expression_MustUse #-} +sem_Expression_MustUse :: T_Range -> T_Expression -> T_Expression +sem_Expression_MustUse arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule84 _expressionIallVariables + _self = rule85 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule86 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule84 #-} + rule84 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule85 #-} + rule85 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_MustUse _rangeIself _expressionIself + {-# INLINE rule86 #-} + rule86 = \ _self -> + _self +{-# NOINLINE sem_Expression_Literal #-} +sem_Expression_Literal :: T_Range -> T_Literal -> T_Expression +sem_Expression_Literal arg_range_ arg_literal_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX89 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Literal_vOut88 _literalIself) = inv_Literal_s89 _literalX89 (T_Literal_vIn88 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule87 () + _self = rule88 _literalIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule89 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule87 #-} + rule87 = \ (_ :: ()) -> + [] + {-# INLINE rule88 #-} + rule88 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Expression_Literal _rangeIself _literalIself + {-# INLINE rule89 #-} + rule89 = \ _self -> + _self +{-# NOINLINE sem_Expression_Variable #-} +sem_Expression_Variable :: T_Range -> T_Name -> T_Expression +sem_Expression_Variable arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule90 _nameIself + _self = rule91 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule92 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule90 #-} + rule90 = \ ((_nameIself) :: Name) -> + [(_nameIself, Variable)] + {-# INLINE rule91 #-} + rule91 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Variable _rangeIself _nameIself + {-# INLINE rule92 #-} + rule92 = \ _self -> + _self +{-# NOINLINE sem_Expression_Constructor #-} +sem_Expression_Constructor :: T_Range -> T_Name -> T_Expression +sem_Expression_Constructor arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule93 _nameIself + _self = rule94 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule95 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule93 #-} + rule93 = \ ((_nameIself) :: Name) -> + [(_nameIself, Constructor)] + {-# INLINE rule94 #-} + rule94 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Constructor _rangeIself _nameIself + {-# INLINE rule95 #-} + rule95 = \ _self -> + _self +{-# NOINLINE sem_Expression_Parenthesized #-} +sem_Expression_Parenthesized :: T_Range -> T_Expression -> T_Expression +sem_Expression_Parenthesized arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule96 _expressionIallVariables + _self = rule97 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule98 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule96 #-} + rule96 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule97 #-} + rule97 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Parenthesized _rangeIself _expressionIself + {-# INLINE rule98 #-} + rule98 = \ _self -> + _self +{-# NOINLINE sem_Expression_NormalApplication #-} +sem_Expression_NormalApplication :: T_Range -> T_Expression -> T_Expressions -> T_Expression +sem_Expression_NormalApplication arg_range_ arg_function_ arg_arguments_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_function_)) + _argumentsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_arguments_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _functionIallVariables _functionIself) = inv_Expression_s41 _functionX41 (T_Expression_vIn40 ) + (T_Expressions_vOut43 _argumentsIallVariables _argumentsIself) = inv_Expressions_s44 _argumentsX44 (T_Expressions_vIn43 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule99 _argumentsIallVariables _functionIallVariables + _self = rule100 _argumentsIself _functionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule101 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule99 #-} + rule99 = \ ((_argumentsIallVariables) :: [(Name,Entity)]) ((_functionIallVariables) :: [(Name,Entity)]) -> + _functionIallVariables ++ _argumentsIallVariables + {-# INLINE rule100 #-} + rule100 = \ ((_argumentsIself) :: Expressions) ((_functionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NormalApplication _rangeIself _functionIself _argumentsIself + {-# INLINE rule101 #-} + rule101 = \ _self -> + _self +{-# NOINLINE sem_Expression_InfixApplication #-} +sem_Expression_InfixApplication :: T_Range -> T_MaybeExpression -> T_Expression -> T_MaybeExpression -> T_Expression +sem_Expression_InfixApplication arg_range_ arg_leftExpression_ arg_operator_ arg_rightExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftExpressionX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_leftExpression_)) + _operatorX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_operator_)) + _rightExpressionX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_rightExpression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_MaybeExpression_vOut97 _leftExpressionIallVariables _leftExpressionIself) = inv_MaybeExpression_s98 _leftExpressionX98 (T_MaybeExpression_vIn97 ) + (T_Expression_vOut40 _operatorIallVariables _operatorIself) = inv_Expression_s41 _operatorX41 (T_Expression_vIn40 ) + (T_MaybeExpression_vOut97 _rightExpressionIallVariables _rightExpressionIself) = inv_MaybeExpression_s98 _rightExpressionX98 (T_MaybeExpression_vIn97 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule102 _leftExpressionIallVariables _operatorIallVariables _rightExpressionIallVariables + _self = rule103 _leftExpressionIself _operatorIself _rangeIself _rightExpressionIself + _lhsOself :: Expression + _lhsOself = rule104 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule102 #-} + rule102 = \ ((_leftExpressionIallVariables) :: [(Name,Entity)]) ((_operatorIallVariables) :: [(Name,Entity)]) ((_rightExpressionIallVariables) :: [(Name,Entity)]) -> + _leftExpressionIallVariables ++ _operatorIallVariables ++ _rightExpressionIallVariables + {-# INLINE rule103 #-} + rule103 = \ ((_leftExpressionIself) :: MaybeExpression) ((_operatorIself) :: Expression) ((_rangeIself) :: Range) ((_rightExpressionIself) :: MaybeExpression) -> + Expression_InfixApplication _rangeIself _leftExpressionIself _operatorIself _rightExpressionIself + {-# INLINE rule104 #-} + rule104 = \ _self -> + _self +{-# NOINLINE sem_Expression_If #-} +sem_Expression_If :: T_Range -> T_Expression -> T_Expression -> T_Expression -> T_Expression +sem_Expression_If arg_range_ arg_guardExpression_ arg_thenExpression_ arg_elseExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guardExpression_)) + _thenExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_thenExpression_)) + _elseExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_elseExpression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _guardExpressionIallVariables _guardExpressionIself) = inv_Expression_s41 _guardExpressionX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _thenExpressionIallVariables _thenExpressionIself) = inv_Expression_s41 _thenExpressionX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _elseExpressionIallVariables _elseExpressionIself) = inv_Expression_s41 _elseExpressionX41 (T_Expression_vIn40 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule105 _elseExpressionIallVariables _guardExpressionIallVariables _thenExpressionIallVariables + _self = rule106 _elseExpressionIself _guardExpressionIself _rangeIself _thenExpressionIself + _lhsOself :: Expression + _lhsOself = rule107 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule105 #-} + rule105 = \ ((_elseExpressionIallVariables) :: [(Name,Entity)]) ((_guardExpressionIallVariables) :: [(Name,Entity)]) ((_thenExpressionIallVariables) :: [(Name,Entity)]) -> + _guardExpressionIallVariables ++ _thenExpressionIallVariables ++ _elseExpressionIallVariables + {-# INLINE rule106 #-} + rule106 = \ ((_elseExpressionIself) :: Expression) ((_guardExpressionIself) :: Expression) ((_rangeIself) :: Range) ((_thenExpressionIself) :: Expression) -> + Expression_If _rangeIself _guardExpressionIself _thenExpressionIself _elseExpressionIself + {-# INLINE rule107 #-} + rule107 = \ _self -> + _self +{-# NOINLINE sem_Expression_Lambda #-} +sem_Expression_Lambda :: T_Range -> T_Patterns -> T_Expression -> T_Expression +sem_Expression_Lambda arg_range_ arg_patterns_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX125 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Patterns_vOut124 _patternsIself) = inv_Patterns_s125 _patternsX125 (T_Patterns_vIn124 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule108 _expressionIallVariables + _self = rule109 _expressionIself _patternsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule110 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule108 #-} + rule108 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule109 #-} + rule109 = \ ((_expressionIself) :: Expression) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Expression_Lambda _rangeIself _patternsIself _expressionIself + {-# INLINE rule110 #-} + rule110 = \ _self -> + _self +{-# NOINLINE sem_Expression_Case #-} +sem_Expression_Case :: T_Range -> T_Expression -> T_Alternatives -> T_Expression +sem_Expression_Case arg_range_ arg_expression_ arg_alternatives_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _alternativesX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_alternatives_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Alternatives_vOut4 _alternativesIself) = inv_Alternatives_s5 _alternativesX5 (T_Alternatives_vIn4 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule111 _expressionIallVariables + _self = rule112 _alternativesIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule113 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule111 #-} + rule111 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule112 #-} + rule112 = \ ((_alternativesIself) :: Alternatives) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Case _rangeIself _expressionIself _alternativesIself + {-# INLINE rule113 #-} + rule113 = \ _self -> + _self +{-# NOINLINE sem_Expression_Let #-} +sem_Expression_Let :: T_Range -> T_Declarations -> T_Expression -> T_Expression +sem_Expression_Let arg_range_ arg_declarations_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Declarations_vOut31 _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule114 _expressionIallVariables + _self = rule115 _declarationsIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule116 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule114 #-} + rule114 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule115 #-} + rule115 = \ ((_declarationsIself) :: Declarations) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Let _rangeIself _declarationsIself _expressionIself + {-# INLINE rule116 #-} + rule116 = \ _self -> + _self +{-# NOINLINE sem_Expression_Do #-} +sem_Expression_Do :: T_Range -> T_Statements -> T_Expression +sem_Expression_Do arg_range_ arg_statements_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _statementsX167 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_statements_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Statements_vOut166 _statementsIself) = inv_Statements_s167 _statementsX167 (T_Statements_vIn166 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule117 () + _self = rule118 _rangeIself _statementsIself + _lhsOself :: Expression + _lhsOself = rule119 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule117 #-} + rule117 = \ (_ :: ()) -> + [] + {-# INLINE rule118 #-} + rule118 = \ ((_rangeIself) :: Range) ((_statementsIself) :: Statements) -> + Expression_Do _rangeIself _statementsIself + {-# INLINE rule119 #-} + rule119 = \ _self -> + _self +{-# NOINLINE sem_Expression_List #-} +sem_Expression_List :: T_Range -> T_Expressions -> T_Expression +sem_Expression_List arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expressions_vOut43 _expressionsIallVariables _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule120 _expressionsIallVariables + _self = rule121 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule122 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule120 #-} + rule120 = \ ((_expressionsIallVariables) :: [(Name,Entity)]) -> + _expressionsIallVariables + {-# INLINE rule121 #-} + rule121 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_List _rangeIself _expressionsIself + {-# INLINE rule122 #-} + rule122 = \ _self -> + _self +{-# NOINLINE sem_Expression_Tuple #-} +sem_Expression_Tuple :: T_Range -> T_Expressions -> T_Expression +sem_Expression_Tuple arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expressions_vOut43 _expressionsIallVariables _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule123 _expressionsIallVariables + _self = rule124 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule125 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule123 #-} + rule123 = \ ((_expressionsIallVariables) :: [(Name,Entity)]) -> + _expressionsIallVariables + {-# INLINE rule124 #-} + rule124 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_Tuple _rangeIself _expressionsIself + {-# INLINE rule125 #-} + rule125 = \ _self -> + _self +{-# NOINLINE sem_Expression_Comprehension #-} +sem_Expression_Comprehension :: T_Range -> T_Expression -> T_Qualifiers -> T_Expression +sem_Expression_Comprehension arg_range_ arg_expression_ arg_qualifiers_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _qualifiersX134 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_qualifiers_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Qualifiers_vOut133 _qualifiersIself) = inv_Qualifiers_s134 _qualifiersX134 (T_Qualifiers_vIn133 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule126 _expressionIallVariables + _self = rule127 _expressionIself _qualifiersIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule128 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule126 #-} + rule126 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule127 #-} + rule127 = \ ((_expressionIself) :: Expression) ((_qualifiersIself) :: Qualifiers) ((_rangeIself) :: Range) -> + Expression_Comprehension _rangeIself _expressionIself _qualifiersIself + {-# INLINE rule128 #-} + rule128 = \ _self -> + _self +{-# NOINLINE sem_Expression_Typed #-} +sem_Expression_Typed :: T_Range -> T_Expression -> T_Type -> T_Expression +sem_Expression_Typed arg_range_ arg_expression_ arg_type_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _typeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Type_vOut172 _typeIself _typeItypevariables) = inv_Type_s173 _typeX173 (T_Type_vIn172 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule129 _expressionIallVariables + _self = rule130 _expressionIself _rangeIself _typeIself + _lhsOself :: Expression + _lhsOself = rule131 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule129 #-} + rule129 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule130 #-} + rule130 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Expression_Typed _rangeIself _expressionIself _typeIself + {-# INLINE rule131 #-} + rule131 = \ _self -> + _self +{-# NOINLINE sem_Expression_RecordConstruction #-} +sem_Expression_RecordConstruction :: T_Range -> T_Name -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordConstruction arg_range_ arg_name_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordExpressionBindingsX143 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_RecordExpressionBindings_vOut142 _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s143 _recordExpressionBindingsX143 (T_RecordExpressionBindings_vIn142 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule132 () + _self = rule133 _nameIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule134 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule132 #-} + rule132 = \ (_ :: ()) -> + [] + {-# INLINE rule133 #-} + rule133 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordConstruction _rangeIself _nameIself _recordExpressionBindingsIself + {-# INLINE rule134 #-} + rule134 = \ _self -> + _self +{-# NOINLINE sem_Expression_RecordUpdate #-} +sem_Expression_RecordUpdate :: T_Range -> T_Expression -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordUpdate arg_range_ arg_expression_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _recordExpressionBindingsX143 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_RecordExpressionBindings_vOut142 _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s143 _recordExpressionBindingsX143 (T_RecordExpressionBindings_vIn142 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule135 _expressionIallVariables + _self = rule136 _expressionIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule137 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule135 #-} + rule135 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule136 #-} + rule136 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordUpdate _rangeIself _expressionIself _recordExpressionBindingsIself + {-# INLINE rule137 #-} + rule137 = \ _self -> + _self +{-# NOINLINE sem_Expression_Enum #-} +sem_Expression_Enum :: T_Range -> T_Expression -> T_MaybeExpression -> T_MaybeExpression -> T_Expression +sem_Expression_Enum arg_range_ arg_from_ arg_then_ arg_to_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fromX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_from_)) + _thenX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_then_)) + _toX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_to_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _fromIallVariables _fromIself) = inv_Expression_s41 _fromX41 (T_Expression_vIn40 ) + (T_MaybeExpression_vOut97 _thenIallVariables _thenIself) = inv_MaybeExpression_s98 _thenX98 (T_MaybeExpression_vIn97 ) + (T_MaybeExpression_vOut97 _toIallVariables _toIself) = inv_MaybeExpression_s98 _toX98 (T_MaybeExpression_vIn97 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule138 _fromIallVariables _thenIallVariables _toIallVariables + _self = rule139 _fromIself _rangeIself _thenIself _toIself + _lhsOself :: Expression + _lhsOself = rule140 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule138 #-} + rule138 = \ ((_fromIallVariables) :: [(Name,Entity)]) ((_thenIallVariables) :: [(Name,Entity)]) ((_toIallVariables) :: [(Name,Entity)]) -> + _fromIallVariables ++ _thenIallVariables ++ _toIallVariables + {-# INLINE rule139 #-} + rule139 = \ ((_fromIself) :: Expression) ((_rangeIself) :: Range) ((_thenIself) :: MaybeExpression) ((_toIself) :: MaybeExpression) -> + Expression_Enum _rangeIself _fromIself _thenIself _toIself + {-# INLINE rule140 #-} + rule140 = \ _self -> + _self +{-# NOINLINE sem_Expression_Negate #-} +sem_Expression_Negate :: T_Range -> T_Expression -> T_Expression +sem_Expression_Negate arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule141 _expressionIallVariables + _self = rule142 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule143 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule141 #-} + rule141 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule142 #-} + rule142 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Negate _rangeIself _expressionIself + {-# INLINE rule143 #-} + rule143 = \ _self -> + _self +{-# NOINLINE sem_Expression_NegateFloat #-} +sem_Expression_NegateFloat :: T_Range -> T_Expression -> T_Expression +sem_Expression_NegateFloat arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule144 _expressionIallVariables + _self = rule145 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule146 _self + __result_ = T_Expression_vOut40 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule144 #-} + rule144 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule145 #-} + rule145 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NegateFloat _rangeIself _expressionIself + {-# INLINE rule146 #-} + rule146 = \ _self -> + _self + +-- Expressions ------------------------------------------------- +-- wrapper +data Inh_Expressions = Inh_Expressions { } +data Syn_Expressions = Syn_Expressions { allVariables_Syn_Expressions :: ([(Name,Entity)]), self_Syn_Expressions :: (Expressions) } +{-# INLINABLE wrap_Expressions #-} +wrap_Expressions :: T_Expressions -> Inh_Expressions -> (Syn_Expressions ) +wrap_Expressions (T_Expressions act) (Inh_Expressions ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expressions_vIn43 + (T_Expressions_vOut43 _lhsOallVariables _lhsOself) <- return (inv_Expressions_s44 sem arg) + return (Syn_Expressions _lhsOallVariables _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expressions #-} +sem_Expressions :: Expressions -> T_Expressions +sem_Expressions list = Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list) + +-- semantic domain +newtype T_Expressions = T_Expressions { + attach_T_Expressions :: Identity (T_Expressions_s44 ) + } +newtype T_Expressions_s44 = C_Expressions_s44 { + inv_Expressions_s44 :: (T_Expressions_v43 ) + } +data T_Expressions_s45 = C_Expressions_s45 +type T_Expressions_v43 = (T_Expressions_vIn43 ) -> (T_Expressions_vOut43 ) +data T_Expressions_vIn43 = T_Expressions_vIn43 +data T_Expressions_vOut43 = T_Expressions_vOut43 ([(Name,Entity)]) (Expressions) +{-# NOINLINE sem_Expressions_Cons #-} +sem_Expressions_Cons :: T_Expression -> T_Expressions -> T_Expressions +sem_Expressions_Cons arg_hd_ arg_tl_ = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 ) -> ( let + _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_hd_)) + _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_tl_)) + (T_Expression_vOut40 _hdIallVariables _hdIself) = inv_Expression_s41 _hdX41 (T_Expression_vIn40 ) + (T_Expressions_vOut43 _tlIallVariables _tlIself) = inv_Expressions_s44 _tlX44 (T_Expressions_vIn43 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule147 _hdIallVariables _tlIallVariables + _self = rule148 _hdIself _tlIself + _lhsOself :: Expressions + _lhsOself = rule149 _self + __result_ = T_Expressions_vOut43 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule147 #-} + rule147 = \ ((_hdIallVariables) :: [(Name,Entity)]) ((_tlIallVariables) :: [(Name,Entity)]) -> + _hdIallVariables ++ _tlIallVariables + {-# INLINE rule148 #-} + rule148 = \ ((_hdIself) :: Expression) ((_tlIself) :: Expressions) -> + (:) _hdIself _tlIself + {-# INLINE rule149 #-} + rule149 = \ _self -> + _self +{-# NOINLINE sem_Expressions_Nil #-} +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 ) -> ( let + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule150 () + _self = rule151 () + _lhsOself :: Expressions + _lhsOself = rule152 _self + __result_ = T_Expressions_vOut43 _lhsOallVariables _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule150 #-} + rule150 = \ (_ :: ()) -> + [] + {-# INLINE rule151 #-} + rule151 = \ (_ :: ()) -> + [] + {-# INLINE rule152 #-} + rule152 = \ _self -> + _self + +-- FieldDeclaration -------------------------------------------- +-- wrapper +data Inh_FieldDeclaration = Inh_FieldDeclaration { } +data Syn_FieldDeclaration = Syn_FieldDeclaration { self_Syn_FieldDeclaration :: (FieldDeclaration) } +{-# INLINABLE wrap_FieldDeclaration #-} +wrap_FieldDeclaration :: T_FieldDeclaration -> Inh_FieldDeclaration -> (Syn_FieldDeclaration ) +wrap_FieldDeclaration (T_FieldDeclaration act) (Inh_FieldDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclaration_vIn46 + (T_FieldDeclaration_vOut46 _lhsOself) <- return (inv_FieldDeclaration_s47 sem arg) + return (Syn_FieldDeclaration _lhsOself) + ) + +-- cata +{-# INLINE sem_FieldDeclaration #-} +sem_FieldDeclaration :: FieldDeclaration -> T_FieldDeclaration +sem_FieldDeclaration ( FieldDeclaration_FieldDeclaration range_ names_ type_ ) = sem_FieldDeclaration_FieldDeclaration ( sem_Range range_ ) ( sem_Names names_ ) ( sem_AnnotatedType type_ ) + +-- semantic domain +newtype T_FieldDeclaration = T_FieldDeclaration { + attach_T_FieldDeclaration :: Identity (T_FieldDeclaration_s47 ) + } +newtype T_FieldDeclaration_s47 = C_FieldDeclaration_s47 { + inv_FieldDeclaration_s47 :: (T_FieldDeclaration_v46 ) + } +data T_FieldDeclaration_s48 = C_FieldDeclaration_s48 +type T_FieldDeclaration_v46 = (T_FieldDeclaration_vIn46 ) -> (T_FieldDeclaration_vOut46 ) +data T_FieldDeclaration_vIn46 = T_FieldDeclaration_vIn46 +data T_FieldDeclaration_vOut46 = T_FieldDeclaration_vOut46 (FieldDeclaration) +{-# NOINLINE sem_FieldDeclaration_FieldDeclaration #-} +sem_FieldDeclaration_FieldDeclaration :: T_Range -> T_Names -> T_AnnotatedType -> T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration arg_range_ arg_names_ arg_type_ = T_FieldDeclaration (return st47) where + {-# NOINLINE st47 #-} + st47 = let + v46 :: T_FieldDeclaration_v46 + v46 = \ (T_FieldDeclaration_vIn46 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX119 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_type_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Names_vOut118 _namesIself) = inv_Names_s119 _namesX119 (T_Names_vIn118 ) + (T_AnnotatedType_vOut7 _typeIself) = inv_AnnotatedType_s8 _typeX8 (T_AnnotatedType_vIn7 ) + _self = rule153 _namesIself _rangeIself _typeIself + _lhsOself :: FieldDeclaration + _lhsOself = rule154 _self + __result_ = T_FieldDeclaration_vOut46 _lhsOself + in __result_ ) + in C_FieldDeclaration_s47 v46 + {-# INLINE rule153 #-} + rule153 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: AnnotatedType) -> + FieldDeclaration_FieldDeclaration _rangeIself _namesIself _typeIself + {-# INLINE rule154 #-} + rule154 = \ _self -> + _self + +-- FieldDeclarations ------------------------------------------- +-- wrapper +data Inh_FieldDeclarations = Inh_FieldDeclarations { } +data Syn_FieldDeclarations = Syn_FieldDeclarations { self_Syn_FieldDeclarations :: (FieldDeclarations) } +{-# INLINABLE wrap_FieldDeclarations #-} +wrap_FieldDeclarations :: T_FieldDeclarations -> Inh_FieldDeclarations -> (Syn_FieldDeclarations ) +wrap_FieldDeclarations (T_FieldDeclarations act) (Inh_FieldDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclarations_vIn49 + (T_FieldDeclarations_vOut49 _lhsOself) <- return (inv_FieldDeclarations_s50 sem arg) + return (Syn_FieldDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FieldDeclarations #-} +sem_FieldDeclarations :: FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations list = Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list) + +-- semantic domain +newtype T_FieldDeclarations = T_FieldDeclarations { + attach_T_FieldDeclarations :: Identity (T_FieldDeclarations_s50 ) + } +newtype T_FieldDeclarations_s50 = C_FieldDeclarations_s50 { + inv_FieldDeclarations_s50 :: (T_FieldDeclarations_v49 ) + } +data T_FieldDeclarations_s51 = C_FieldDeclarations_s51 +type T_FieldDeclarations_v49 = (T_FieldDeclarations_vIn49 ) -> (T_FieldDeclarations_vOut49 ) +data T_FieldDeclarations_vIn49 = T_FieldDeclarations_vIn49 +data T_FieldDeclarations_vOut49 = T_FieldDeclarations_vOut49 (FieldDeclarations) +{-# NOINLINE sem_FieldDeclarations_Cons #-} +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> T_FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations_Cons arg_hd_ arg_tl_ = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _hdX47 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclaration (arg_hd_)) + _tlX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_tl_)) + (T_FieldDeclaration_vOut46 _hdIself) = inv_FieldDeclaration_s47 _hdX47 (T_FieldDeclaration_vIn46 ) + (T_FieldDeclarations_vOut49 _tlIself) = inv_FieldDeclarations_s50 _tlX50 (T_FieldDeclarations_vIn49 ) + _self = rule155 _hdIself _tlIself + _lhsOself :: FieldDeclarations + _lhsOself = rule156 _self + __result_ = T_FieldDeclarations_vOut49 _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule155 #-} + rule155 = \ ((_hdIself) :: FieldDeclaration) ((_tlIself) :: FieldDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule156 #-} + rule156 = \ _self -> + _self +{-# NOINLINE sem_FieldDeclarations_Nil #-} +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _self = rule157 () + _lhsOself :: FieldDeclarations + _lhsOself = rule158 _self + __result_ = T_FieldDeclarations_vOut49 _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule157 #-} + rule157 = \ (_ :: ()) -> + [] + {-# INLINE rule158 #-} + rule158 = \ _self -> + _self + +-- Fixity ------------------------------------------------------ +-- wrapper +data Inh_Fixity = Inh_Fixity { } +data Syn_Fixity = Syn_Fixity { self_Syn_Fixity :: (Fixity) } +{-# INLINABLE wrap_Fixity #-} +wrap_Fixity :: T_Fixity -> Inh_Fixity -> (Syn_Fixity ) +wrap_Fixity (T_Fixity act) (Inh_Fixity ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Fixity_vIn52 + (T_Fixity_vOut52 _lhsOself) <- return (inv_Fixity_s53 sem arg) + return (Syn_Fixity _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Fixity #-} +sem_Fixity :: Fixity -> T_Fixity +sem_Fixity ( Fixity_Infixl range_ ) = sem_Fixity_Infixl ( sem_Range range_ ) +sem_Fixity ( Fixity_Infixr range_ ) = sem_Fixity_Infixr ( sem_Range range_ ) +sem_Fixity ( Fixity_Infix range_ ) = sem_Fixity_Infix ( sem_Range range_ ) + +-- semantic domain +newtype T_Fixity = T_Fixity { + attach_T_Fixity :: Identity (T_Fixity_s53 ) + } +newtype T_Fixity_s53 = C_Fixity_s53 { + inv_Fixity_s53 :: (T_Fixity_v52 ) + } +data T_Fixity_s54 = C_Fixity_s54 +type T_Fixity_v52 = (T_Fixity_vIn52 ) -> (T_Fixity_vOut52 ) +data T_Fixity_vIn52 = T_Fixity_vIn52 +data T_Fixity_vOut52 = T_Fixity_vOut52 (Fixity) +{-# NOINLINE sem_Fixity_Infixl #-} +sem_Fixity_Infixl :: T_Range -> T_Fixity +sem_Fixity_Infixl arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule159 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule160 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule159 #-} + rule159 = \ ((_rangeIself) :: Range) -> + Fixity_Infixl _rangeIself + {-# INLINE rule160 #-} + rule160 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infixr #-} +sem_Fixity_Infixr :: T_Range -> T_Fixity +sem_Fixity_Infixr arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule161 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule162 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule161 #-} + rule161 = \ ((_rangeIself) :: Range) -> + Fixity_Infixr _rangeIself + {-# INLINE rule162 #-} + rule162 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infix #-} +sem_Fixity_Infix :: T_Range -> T_Fixity +sem_Fixity_Infix arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule163 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule164 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule163 #-} + rule163 = \ ((_rangeIself) :: Range) -> + Fixity_Infix _rangeIself + {-# INLINE rule164 #-} + rule164 = \ _self -> + _self + +-- FunctionBinding --------------------------------------------- +-- wrapper +data Inh_FunctionBinding = Inh_FunctionBinding { } +data Syn_FunctionBinding = Syn_FunctionBinding { self_Syn_FunctionBinding :: (FunctionBinding) } +{-# INLINABLE wrap_FunctionBinding #-} +wrap_FunctionBinding :: T_FunctionBinding -> Inh_FunctionBinding -> (Syn_FunctionBinding ) +wrap_FunctionBinding (T_FunctionBinding act) (Inh_FunctionBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBinding_vIn55 + (T_FunctionBinding_vOut55 _lhsOself) <- return (inv_FunctionBinding_s56 sem arg) + return (Syn_FunctionBinding _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBinding #-} +sem_FunctionBinding :: FunctionBinding -> T_FunctionBinding +sem_FunctionBinding ( FunctionBinding_Hole range_ id_ ) = sem_FunctionBinding_Hole ( sem_Range range_ ) id_ +sem_FunctionBinding ( FunctionBinding_Feedback range_ feedback_ functionBinding_ ) = sem_FunctionBinding_Feedback ( sem_Range range_ ) feedback_ ( sem_FunctionBinding functionBinding_ ) +sem_FunctionBinding ( FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ ) = sem_FunctionBinding_FunctionBinding ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_RightHandSide righthandside_ ) + +-- semantic domain +newtype T_FunctionBinding = T_FunctionBinding { + attach_T_FunctionBinding :: Identity (T_FunctionBinding_s56 ) + } +newtype T_FunctionBinding_s56 = C_FunctionBinding_s56 { + inv_FunctionBinding_s56 :: (T_FunctionBinding_v55 ) + } +data T_FunctionBinding_s57 = C_FunctionBinding_s57 +type T_FunctionBinding_v55 = (T_FunctionBinding_vIn55 ) -> (T_FunctionBinding_vOut55 ) +data T_FunctionBinding_vIn55 = T_FunctionBinding_vIn55 +data T_FunctionBinding_vOut55 = T_FunctionBinding_vOut55 (FunctionBinding) +{-# NOINLINE sem_FunctionBinding_Hole #-} +sem_FunctionBinding_Hole :: T_Range -> (Integer) -> T_FunctionBinding +sem_FunctionBinding_Hole arg_range_ arg_id_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule165 _rangeIself arg_id_ + _lhsOself :: FunctionBinding + _lhsOself = rule166 _self + __result_ = T_FunctionBinding_vOut55 _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule165 #-} + rule165 = \ ((_rangeIself) :: Range) id_ -> + FunctionBinding_Hole _rangeIself id_ + {-# INLINE rule166 #-} + rule166 = \ _self -> + _self +{-# NOINLINE sem_FunctionBinding_Feedback #-} +sem_FunctionBinding_Feedback :: T_Range -> (String) -> T_FunctionBinding -> T_FunctionBinding +sem_FunctionBinding_Feedback arg_range_ arg_feedback_ arg_functionBinding_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionBindingX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_functionBinding_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_FunctionBinding_vOut55 _functionBindingIself) = inv_FunctionBinding_s56 _functionBindingX56 (T_FunctionBinding_vIn55 ) + _self = rule167 _functionBindingIself _rangeIself arg_feedback_ + _lhsOself :: FunctionBinding + _lhsOself = rule168 _self + __result_ = T_FunctionBinding_vOut55 _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule167 #-} + rule167 = \ ((_functionBindingIself) :: FunctionBinding) ((_rangeIself) :: Range) feedback_ -> + FunctionBinding_Feedback _rangeIself feedback_ _functionBindingIself + {-# INLINE rule168 #-} + rule168 = \ _self -> + _self +{-# NOINLINE sem_FunctionBinding_FunctionBinding #-} +sem_FunctionBinding_FunctionBinding :: T_Range -> T_LeftHandSide -> T_RightHandSide -> T_FunctionBinding +sem_FunctionBinding_FunctionBinding arg_range_ arg_lefthandside_ arg_righthandside_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX86 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _righthandsideX152 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_LeftHandSide_vOut85 _lefthandsideIself) = inv_LeftHandSide_s86 _lefthandsideX86 (T_LeftHandSide_vIn85 ) + (T_RightHandSide_vOut151 _righthandsideIself) = inv_RightHandSide_s152 _righthandsideX152 (T_RightHandSide_vIn151 ) + _self = rule169 _lefthandsideIself _rangeIself _righthandsideIself + _lhsOself :: FunctionBinding + _lhsOself = rule170 _self + __result_ = T_FunctionBinding_vOut55 _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule169 #-} + rule169 = \ ((_lefthandsideIself) :: LeftHandSide) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + FunctionBinding_FunctionBinding _rangeIself _lefthandsideIself _righthandsideIself + {-# INLINE rule170 #-} + rule170 = \ _self -> + _self + +-- FunctionBindings -------------------------------------------- +-- wrapper +data Inh_FunctionBindings = Inh_FunctionBindings { } +data Syn_FunctionBindings = Syn_FunctionBindings { self_Syn_FunctionBindings :: (FunctionBindings) } +{-# INLINABLE wrap_FunctionBindings #-} +wrap_FunctionBindings :: T_FunctionBindings -> Inh_FunctionBindings -> (Syn_FunctionBindings ) +wrap_FunctionBindings (T_FunctionBindings act) (Inh_FunctionBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBindings_vIn58 + (T_FunctionBindings_vOut58 _lhsOself) <- return (inv_FunctionBindings_s59 sem arg) + return (Syn_FunctionBindings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBindings #-} +sem_FunctionBindings :: FunctionBindings -> T_FunctionBindings +sem_FunctionBindings list = Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list) + +-- semantic domain +newtype T_FunctionBindings = T_FunctionBindings { + attach_T_FunctionBindings :: Identity (T_FunctionBindings_s59 ) + } +newtype T_FunctionBindings_s59 = C_FunctionBindings_s59 { + inv_FunctionBindings_s59 :: (T_FunctionBindings_v58 ) + } +data T_FunctionBindings_s60 = C_FunctionBindings_s60 +type T_FunctionBindings_v58 = (T_FunctionBindings_vIn58 ) -> (T_FunctionBindings_vOut58 ) +data T_FunctionBindings_vIn58 = T_FunctionBindings_vIn58 +data T_FunctionBindings_vOut58 = T_FunctionBindings_vOut58 (FunctionBindings) +{-# NOINLINE sem_FunctionBindings_Cons #-} +sem_FunctionBindings_Cons :: T_FunctionBinding -> T_FunctionBindings -> T_FunctionBindings +sem_FunctionBindings_Cons arg_hd_ arg_tl_ = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 ) -> ( let + _hdX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_hd_)) + _tlX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_tl_)) + (T_FunctionBinding_vOut55 _hdIself) = inv_FunctionBinding_s56 _hdX56 (T_FunctionBinding_vIn55 ) + (T_FunctionBindings_vOut58 _tlIself) = inv_FunctionBindings_s59 _tlX59 (T_FunctionBindings_vIn58 ) + _self = rule171 _hdIself _tlIself + _lhsOself :: FunctionBindings + _lhsOself = rule172 _self + __result_ = T_FunctionBindings_vOut58 _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule171 #-} + rule171 = \ ((_hdIself) :: FunctionBinding) ((_tlIself) :: FunctionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule172 #-} + rule172 = \ _self -> + _self +{-# NOINLINE sem_FunctionBindings_Nil #-} +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 ) -> ( let + _self = rule173 () + _lhsOself :: FunctionBindings + _lhsOself = rule174 _self + __result_ = T_FunctionBindings_vOut58 _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule173 #-} + rule173 = \ (_ :: ()) -> + [] + {-# INLINE rule174 #-} + rule174 = \ _self -> + _self + +-- GuardedExpression ------------------------------------------- +-- wrapper +data Inh_GuardedExpression = Inh_GuardedExpression { } +data Syn_GuardedExpression = Syn_GuardedExpression { self_Syn_GuardedExpression :: (GuardedExpression) } +{-# INLINABLE wrap_GuardedExpression #-} +wrap_GuardedExpression :: T_GuardedExpression -> Inh_GuardedExpression -> (Syn_GuardedExpression ) +wrap_GuardedExpression (T_GuardedExpression act) (Inh_GuardedExpression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpression_vIn61 + (T_GuardedExpression_vOut61 _lhsOself) <- return (inv_GuardedExpression_s62 sem arg) + return (Syn_GuardedExpression _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpression #-} +sem_GuardedExpression :: GuardedExpression -> T_GuardedExpression +sem_GuardedExpression ( GuardedExpression_GuardedExpression range_ guard_ expression_ ) = sem_GuardedExpression_GuardedExpression ( sem_Range range_ ) ( sem_Expression guard_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_GuardedExpression = T_GuardedExpression { + attach_T_GuardedExpression :: Identity (T_GuardedExpression_s62 ) + } +newtype T_GuardedExpression_s62 = C_GuardedExpression_s62 { + inv_GuardedExpression_s62 :: (T_GuardedExpression_v61 ) + } +data T_GuardedExpression_s63 = C_GuardedExpression_s63 +type T_GuardedExpression_v61 = (T_GuardedExpression_vIn61 ) -> (T_GuardedExpression_vOut61 ) +data T_GuardedExpression_vIn61 = T_GuardedExpression_vIn61 +data T_GuardedExpression_vOut61 = T_GuardedExpression_vOut61 (GuardedExpression) +{-# NOINLINE sem_GuardedExpression_GuardedExpression #-} +sem_GuardedExpression_GuardedExpression :: T_Range -> T_Expression -> T_Expression -> T_GuardedExpression +sem_GuardedExpression_GuardedExpression arg_range_ arg_guard_ arg_expression_ = T_GuardedExpression (return st62) where + {-# NOINLINE st62 #-} + st62 = let + v61 :: T_GuardedExpression_v61 + v61 = \ (T_GuardedExpression_vIn61 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _guardIallVariables _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule175 _expressionIself _guardIself _rangeIself + _lhsOself :: GuardedExpression + _lhsOself = rule176 _self + __result_ = T_GuardedExpression_vOut61 _lhsOself + in __result_ ) + in C_GuardedExpression_s62 v61 + {-# INLINE rule175 #-} + rule175 = \ ((_expressionIself) :: Expression) ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + GuardedExpression_GuardedExpression _rangeIself _guardIself _expressionIself + {-# INLINE rule176 #-} + rule176 = \ _self -> + _self + +-- GuardedExpressions ------------------------------------------ +-- wrapper +data Inh_GuardedExpressions = Inh_GuardedExpressions { } +data Syn_GuardedExpressions = Syn_GuardedExpressions { self_Syn_GuardedExpressions :: (GuardedExpressions) } +{-# INLINABLE wrap_GuardedExpressions #-} +wrap_GuardedExpressions :: T_GuardedExpressions -> Inh_GuardedExpressions -> (Syn_GuardedExpressions ) +wrap_GuardedExpressions (T_GuardedExpressions act) (Inh_GuardedExpressions ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpressions_vIn64 + (T_GuardedExpressions_vOut64 _lhsOself) <- return (inv_GuardedExpressions_s65 sem arg) + return (Syn_GuardedExpressions _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpressions #-} +sem_GuardedExpressions :: GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions list = Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list) + +-- semantic domain +newtype T_GuardedExpressions = T_GuardedExpressions { + attach_T_GuardedExpressions :: Identity (T_GuardedExpressions_s65 ) + } +newtype T_GuardedExpressions_s65 = C_GuardedExpressions_s65 { + inv_GuardedExpressions_s65 :: (T_GuardedExpressions_v64 ) + } +data T_GuardedExpressions_s66 = C_GuardedExpressions_s66 +type T_GuardedExpressions_v64 = (T_GuardedExpressions_vIn64 ) -> (T_GuardedExpressions_vOut64 ) +data T_GuardedExpressions_vIn64 = T_GuardedExpressions_vIn64 +data T_GuardedExpressions_vOut64 = T_GuardedExpressions_vOut64 (GuardedExpressions) +{-# NOINLINE sem_GuardedExpressions_Cons #-} +sem_GuardedExpressions_Cons :: T_GuardedExpression -> T_GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions_Cons arg_hd_ arg_tl_ = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 ) -> ( let + _hdX62 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpression (arg_hd_)) + _tlX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_tl_)) + (T_GuardedExpression_vOut61 _hdIself) = inv_GuardedExpression_s62 _hdX62 (T_GuardedExpression_vIn61 ) + (T_GuardedExpressions_vOut64 _tlIself) = inv_GuardedExpressions_s65 _tlX65 (T_GuardedExpressions_vIn64 ) + _self = rule177 _hdIself _tlIself + _lhsOself :: GuardedExpressions + _lhsOself = rule178 _self + __result_ = T_GuardedExpressions_vOut64 _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule177 #-} + rule177 = \ ((_hdIself) :: GuardedExpression) ((_tlIself) :: GuardedExpressions) -> + (:) _hdIself _tlIself + {-# INLINE rule178 #-} + rule178 = \ _self -> + _self +{-# NOINLINE sem_GuardedExpressions_Nil #-} +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 ) -> ( let + _self = rule179 () + _lhsOself :: GuardedExpressions + _lhsOself = rule180 _self + __result_ = T_GuardedExpressions_vOut64 _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule179 #-} + rule179 = \ (_ :: ()) -> + [] + {-# INLINE rule180 #-} + rule180 = \ _self -> + _self + +-- Import ------------------------------------------------------ +-- wrapper +data Inh_Import = Inh_Import { } +data Syn_Import = Syn_Import { self_Syn_Import :: (Import) } +{-# INLINABLE wrap_Import #-} +wrap_Import :: T_Import -> Inh_Import -> (Syn_Import ) +wrap_Import (T_Import act) (Inh_Import ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Import_vIn67 + (T_Import_vOut67 _lhsOself) <- return (inv_Import_s68 sem arg) + return (Syn_Import _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Import #-} +sem_Import :: Import -> T_Import +sem_Import ( Import_Variable range_ name_ ) = sem_Import_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Import ( Import_TypeOrClass range_ name_ names_ ) = sem_Import_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Import ( Import_TypeOrClassComplete range_ name_ ) = sem_Import_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Import = T_Import { + attach_T_Import :: Identity (T_Import_s68 ) + } +newtype T_Import_s68 = C_Import_s68 { + inv_Import_s68 :: (T_Import_v67 ) + } +data T_Import_s69 = C_Import_s69 +type T_Import_v67 = (T_Import_vIn67 ) -> (T_Import_vOut67 ) +data T_Import_vIn67 = T_Import_vIn67 +data T_Import_vOut67 = T_Import_vOut67 (Import) +{-# NOINLINE sem_Import_Variable #-} +sem_Import_Variable :: T_Range -> T_Name -> T_Import +sem_Import_Variable arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _self = rule181 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule182 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule181 #-} + rule181 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_Variable _rangeIself _nameIself + {-# INLINE rule182 #-} + rule182 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClass #-} +sem_Import_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Import +sem_Import_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX110 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_MaybeNames_vOut109 _namesIself) = inv_MaybeNames_s110 _namesX110 (T_MaybeNames_vIn109 ) + _self = rule183 _nameIself _namesIself _rangeIself + _lhsOself :: Import + _lhsOself = rule184 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule183 #-} + rule183 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Import_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule184 #-} + rule184 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClassComplete #-} +sem_Import_TypeOrClassComplete :: T_Range -> T_Name -> T_Import +sem_Import_TypeOrClassComplete arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _self = rule185 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule186 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule185 #-} + rule185 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule186 #-} + rule186 = \ _self -> + _self + +-- ImportDeclaration ------------------------------------------- +-- wrapper +data Inh_ImportDeclaration = Inh_ImportDeclaration { } +data Syn_ImportDeclaration = Syn_ImportDeclaration { self_Syn_ImportDeclaration :: (ImportDeclaration) } +{-# INLINABLE wrap_ImportDeclaration #-} +wrap_ImportDeclaration :: T_ImportDeclaration -> Inh_ImportDeclaration -> (Syn_ImportDeclaration ) +wrap_ImportDeclaration (T_ImportDeclaration act) (Inh_ImportDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclaration_vIn70 + (T_ImportDeclaration_vOut70 _lhsOself) <- return (inv_ImportDeclaration_s71 sem arg) + return (Syn_ImportDeclaration _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclaration #-} +sem_ImportDeclaration :: ImportDeclaration -> T_ImportDeclaration +sem_ImportDeclaration ( ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ ) = sem_ImportDeclaration_Import ( sem_Range range_ ) qualified_ ( sem_Name name_ ) ( sem_MaybeName asname_ ) ( sem_MaybeImportSpecification importspecification_ ) +sem_ImportDeclaration ( ImportDeclaration_Empty range_ ) = sem_ImportDeclaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_ImportDeclaration = T_ImportDeclaration { + attach_T_ImportDeclaration :: Identity (T_ImportDeclaration_s71 ) + } +newtype T_ImportDeclaration_s71 = C_ImportDeclaration_s71 { + inv_ImportDeclaration_s71 :: (T_ImportDeclaration_v70 ) + } +data T_ImportDeclaration_s72 = C_ImportDeclaration_s72 +type T_ImportDeclaration_v70 = (T_ImportDeclaration_vIn70 ) -> (T_ImportDeclaration_vOut70 ) +data T_ImportDeclaration_vIn70 = T_ImportDeclaration_vIn70 +data T_ImportDeclaration_vOut70 = T_ImportDeclaration_vOut70 (ImportDeclaration) +{-# NOINLINE sem_ImportDeclaration_Import #-} +sem_ImportDeclaration_Import :: T_Range -> (Bool) -> T_Name -> T_MaybeName -> T_MaybeImportSpecification -> T_ImportDeclaration +sem_ImportDeclaration_Import arg_range_ arg_qualified_ arg_name_ arg_asname_ arg_importspecification_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _asnameX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_asname_)) + _importspecificationX101 = Control.Monad.Identity.runIdentity (attach_T_MaybeImportSpecification (arg_importspecification_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_MaybeName_vOut106 _asnameIself) = inv_MaybeName_s107 _asnameX107 (T_MaybeName_vIn106 ) + (T_MaybeImportSpecification_vOut100 _importspecificationIself) = inv_MaybeImportSpecification_s101 _importspecificationX101 (T_MaybeImportSpecification_vIn100 ) + _self = rule187 _asnameIself _importspecificationIself _nameIself _rangeIself arg_qualified_ + _lhsOself :: ImportDeclaration + _lhsOself = rule188 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule187 #-} + rule187 = \ ((_asnameIself) :: MaybeName) ((_importspecificationIself) :: MaybeImportSpecification) ((_nameIself) :: Name) ((_rangeIself) :: Range) qualified_ -> + ImportDeclaration_Import _rangeIself qualified_ _nameIself _asnameIself _importspecificationIself + {-# INLINE rule188 #-} + rule188 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclaration_Empty #-} +sem_ImportDeclaration_Empty :: T_Range -> T_ImportDeclaration +sem_ImportDeclaration_Empty arg_range_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule189 _rangeIself + _lhsOself :: ImportDeclaration + _lhsOself = rule190 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule189 #-} + rule189 = \ ((_rangeIself) :: Range) -> + ImportDeclaration_Empty _rangeIself + {-# INLINE rule190 #-} + rule190 = \ _self -> + _self + +-- ImportDeclarations ------------------------------------------ +-- wrapper +data Inh_ImportDeclarations = Inh_ImportDeclarations { } +data Syn_ImportDeclarations = Syn_ImportDeclarations { self_Syn_ImportDeclarations :: (ImportDeclarations) } +{-# INLINABLE wrap_ImportDeclarations #-} +wrap_ImportDeclarations :: T_ImportDeclarations -> Inh_ImportDeclarations -> (Syn_ImportDeclarations ) +wrap_ImportDeclarations (T_ImportDeclarations act) (Inh_ImportDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclarations_vIn73 + (T_ImportDeclarations_vOut73 _lhsOself) <- return (inv_ImportDeclarations_s74 sem arg) + return (Syn_ImportDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclarations #-} +sem_ImportDeclarations :: ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations list = Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list) + +-- semantic domain +newtype T_ImportDeclarations = T_ImportDeclarations { + attach_T_ImportDeclarations :: Identity (T_ImportDeclarations_s74 ) + } +newtype T_ImportDeclarations_s74 = C_ImportDeclarations_s74 { + inv_ImportDeclarations_s74 :: (T_ImportDeclarations_v73 ) + } +data T_ImportDeclarations_s75 = C_ImportDeclarations_s75 +type T_ImportDeclarations_v73 = (T_ImportDeclarations_vIn73 ) -> (T_ImportDeclarations_vOut73 ) +data T_ImportDeclarations_vIn73 = T_ImportDeclarations_vIn73 +data T_ImportDeclarations_vOut73 = T_ImportDeclarations_vOut73 (ImportDeclarations) +{-# NOINLINE sem_ImportDeclarations_Cons #-} +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> T_ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations_Cons arg_hd_ arg_tl_ = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _hdX71 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclaration (arg_hd_)) + _tlX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_tl_)) + (T_ImportDeclaration_vOut70 _hdIself) = inv_ImportDeclaration_s71 _hdX71 (T_ImportDeclaration_vIn70 ) + (T_ImportDeclarations_vOut73 _tlIself) = inv_ImportDeclarations_s74 _tlX74 (T_ImportDeclarations_vIn73 ) + _self = rule191 _hdIself _tlIself + _lhsOself :: ImportDeclarations + _lhsOself = rule192 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule191 #-} + rule191 = \ ((_hdIself) :: ImportDeclaration) ((_tlIself) :: ImportDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule192 #-} + rule192 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclarations_Nil #-} +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _self = rule193 () + _lhsOself :: ImportDeclarations + _lhsOself = rule194 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule193 #-} + rule193 = \ (_ :: ()) -> + [] + {-# INLINE rule194 #-} + rule194 = \ _self -> + _self + +-- ImportSpecification ----------------------------------------- +-- wrapper +data Inh_ImportSpecification = Inh_ImportSpecification { } +data Syn_ImportSpecification = Syn_ImportSpecification { self_Syn_ImportSpecification :: (ImportSpecification) } +{-# INLINABLE wrap_ImportSpecification #-} +wrap_ImportSpecification :: T_ImportSpecification -> Inh_ImportSpecification -> (Syn_ImportSpecification ) +wrap_ImportSpecification (T_ImportSpecification act) (Inh_ImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportSpecification_vIn76 + (T_ImportSpecification_vOut76 _lhsOself) <- return (inv_ImportSpecification_s77 sem arg) + return (Syn_ImportSpecification _lhsOself) + ) + +-- cata +{-# INLINE sem_ImportSpecification #-} +sem_ImportSpecification :: ImportSpecification -> T_ImportSpecification +sem_ImportSpecification ( ImportSpecification_Import range_ hiding_ imports_ ) = sem_ImportSpecification_Import ( sem_Range range_ ) hiding_ ( sem_Imports imports_ ) + +-- semantic domain +newtype T_ImportSpecification = T_ImportSpecification { + attach_T_ImportSpecification :: Identity (T_ImportSpecification_s77 ) + } +newtype T_ImportSpecification_s77 = C_ImportSpecification_s77 { + inv_ImportSpecification_s77 :: (T_ImportSpecification_v76 ) + } +data T_ImportSpecification_s78 = C_ImportSpecification_s78 +type T_ImportSpecification_v76 = (T_ImportSpecification_vIn76 ) -> (T_ImportSpecification_vOut76 ) +data T_ImportSpecification_vIn76 = T_ImportSpecification_vIn76 +data T_ImportSpecification_vOut76 = T_ImportSpecification_vOut76 (ImportSpecification) +{-# NOINLINE sem_ImportSpecification_Import #-} +sem_ImportSpecification_Import :: T_Range -> (Bool) -> T_Imports -> T_ImportSpecification +sem_ImportSpecification_Import arg_range_ arg_hiding_ arg_imports_ = T_ImportSpecification (return st77) where + {-# NOINLINE st77 #-} + st77 = let + v76 :: T_ImportSpecification_v76 + v76 = \ (T_ImportSpecification_vIn76 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importsX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_imports_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Imports_vOut79 _importsIself) = inv_Imports_s80 _importsX80 (T_Imports_vIn79 ) + _self = rule195 _importsIself _rangeIself arg_hiding_ + _lhsOself :: ImportSpecification + _lhsOself = rule196 _self + __result_ = T_ImportSpecification_vOut76 _lhsOself + in __result_ ) + in C_ImportSpecification_s77 v76 + {-# INLINE rule195 #-} + rule195 = \ ((_importsIself) :: Imports) ((_rangeIself) :: Range) hiding_ -> + ImportSpecification_Import _rangeIself hiding_ _importsIself + {-# INLINE rule196 #-} + rule196 = \ _self -> + _self + +-- Imports ----------------------------------------------------- +-- wrapper +data Inh_Imports = Inh_Imports { } +data Syn_Imports = Syn_Imports { self_Syn_Imports :: (Imports) } +{-# INLINABLE wrap_Imports #-} +wrap_Imports :: T_Imports -> Inh_Imports -> (Syn_Imports ) +wrap_Imports (T_Imports act) (Inh_Imports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Imports_vIn79 + (T_Imports_vOut79 _lhsOself) <- return (inv_Imports_s80 sem arg) + return (Syn_Imports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Imports #-} +sem_Imports :: Imports -> T_Imports +sem_Imports list = Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list) + +-- semantic domain +newtype T_Imports = T_Imports { + attach_T_Imports :: Identity (T_Imports_s80 ) + } +newtype T_Imports_s80 = C_Imports_s80 { + inv_Imports_s80 :: (T_Imports_v79 ) + } +data T_Imports_s81 = C_Imports_s81 +type T_Imports_v79 = (T_Imports_vIn79 ) -> (T_Imports_vOut79 ) +data T_Imports_vIn79 = T_Imports_vIn79 +data T_Imports_vOut79 = T_Imports_vOut79 (Imports) +{-# NOINLINE sem_Imports_Cons #-} +sem_Imports_Cons :: T_Import -> T_Imports -> T_Imports +sem_Imports_Cons arg_hd_ arg_tl_ = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _hdX68 = Control.Monad.Identity.runIdentity (attach_T_Import (arg_hd_)) + _tlX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_tl_)) + (T_Import_vOut67 _hdIself) = inv_Import_s68 _hdX68 (T_Import_vIn67 ) + (T_Imports_vOut79 _tlIself) = inv_Imports_s80 _tlX80 (T_Imports_vIn79 ) + _self = rule197 _hdIself _tlIself + _lhsOself :: Imports + _lhsOself = rule198 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule197 #-} + rule197 = \ ((_hdIself) :: Import) ((_tlIself) :: Imports) -> + (:) _hdIself _tlIself + {-# INLINE rule198 #-} + rule198 = \ _self -> + _self +{-# NOINLINE sem_Imports_Nil #-} +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _self = rule199 () + _lhsOself :: Imports + _lhsOself = rule200 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule199 #-} + rule199 = \ (_ :: ()) -> + [] + {-# INLINE rule200 #-} + rule200 = \ _self -> + _self + +-- Judgement --------------------------------------------------- +-- wrapper +data Inh_Judgement = Inh_Judgement { nameMap_Inh_Judgement :: ([(Name,Tp)]) } +data Syn_Judgement = Syn_Judgement { allVariables_Syn_Judgement :: ([(Name,Entity)]), conclusionType_Syn_Judgement :: (Tp), self_Syn_Judgement :: (Judgement), theExpression_Syn_Judgement :: (Expression), typevariables_Syn_Judgement :: (Names) } +{-# INLINABLE wrap_Judgement #-} +wrap_Judgement :: T_Judgement -> Inh_Judgement -> (Syn_Judgement ) +wrap_Judgement (T_Judgement act) (Inh_Judgement _lhsInameMap) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Judgement_vIn82 _lhsInameMap + (T_Judgement_vOut82 _lhsOallVariables _lhsOconclusionType _lhsOself _lhsOtheExpression _lhsOtypevariables) <- return (inv_Judgement_s83 sem arg) + return (Syn_Judgement _lhsOallVariables _lhsOconclusionType _lhsOself _lhsOtheExpression _lhsOtypevariables) + ) + +-- cata +{-# INLINE sem_Judgement #-} +sem_Judgement :: Judgement -> T_Judgement +sem_Judgement ( Judgement_Judgement expression_ type_ ) = sem_Judgement_Judgement ( sem_Expression expression_ ) ( sem_Type type_ ) + +-- semantic domain +newtype T_Judgement = T_Judgement { + attach_T_Judgement :: Identity (T_Judgement_s83 ) + } +newtype T_Judgement_s83 = C_Judgement_s83 { + inv_Judgement_s83 :: (T_Judgement_v82 ) + } +data T_Judgement_s84 = C_Judgement_s84 +type T_Judgement_v82 = (T_Judgement_vIn82 ) -> (T_Judgement_vOut82 ) +data T_Judgement_vIn82 = T_Judgement_vIn82 ([(Name,Tp)]) +data T_Judgement_vOut82 = T_Judgement_vOut82 ([(Name,Entity)]) (Tp) (Judgement) (Expression) (Names) +{-# NOINLINE sem_Judgement_Judgement #-} +sem_Judgement_Judgement :: T_Expression -> T_Type -> T_Judgement +sem_Judgement_Judgement arg_expression_ arg_type_ = T_Judgement (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_Judgement_v82 + v82 = \ (T_Judgement_vIn82 _lhsInameMap) -> ( let + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _typeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Type_vOut172 _typeIself _typeItypevariables) = inv_Type_s173 _typeX173 (T_Type_vIn172 ) + _lhsOconclusionType :: Tp + _lhsOconclusionType = rule201 _lhsInameMap _typeIself + _lhsOtheExpression :: Expression + _lhsOtheExpression = rule202 _expressionIself + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule203 _expressionIallVariables + _lhsOtypevariables :: Names + _lhsOtypevariables = rule204 _typeItypevariables + _self = rule205 _expressionIself _typeIself + _lhsOself :: Judgement + _lhsOself = rule206 _self + __result_ = T_Judgement_vOut82 _lhsOallVariables _lhsOconclusionType _lhsOself _lhsOtheExpression _lhsOtypevariables + in __result_ ) + in C_Judgement_s83 v82 + {-# INLINE rule201 #-} + rule201 = \ ((_lhsInameMap) :: [(Name,Tp)]) ((_typeIself) :: Type) -> + makeTpFromType _lhsInameMap _typeIself + {-# INLINE rule202 #-} + rule202 = \ ((_expressionIself) :: Expression) -> + _expressionIself + {-# INLINE rule203 #-} + rule203 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule204 #-} + rule204 = \ ((_typeItypevariables) :: Names) -> + _typeItypevariables + {-# INLINE rule205 #-} + rule205 = \ ((_expressionIself) :: Expression) ((_typeIself) :: Type) -> + Judgement_Judgement _expressionIself _typeIself + {-# INLINE rule206 #-} + rule206 = \ _self -> + _self + +-- LeftHandSide ------------------------------------------------ +-- wrapper +data Inh_LeftHandSide = Inh_LeftHandSide { } +data Syn_LeftHandSide = Syn_LeftHandSide { self_Syn_LeftHandSide :: (LeftHandSide) } +{-# INLINABLE wrap_LeftHandSide #-} +wrap_LeftHandSide :: T_LeftHandSide -> Inh_LeftHandSide -> (Syn_LeftHandSide ) +wrap_LeftHandSide (T_LeftHandSide act) (Inh_LeftHandSide ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_LeftHandSide_vIn85 + (T_LeftHandSide_vOut85 _lhsOself) <- return (inv_LeftHandSide_s86 sem arg) + return (Syn_LeftHandSide _lhsOself) + ) + +-- cata +{-# NOINLINE sem_LeftHandSide #-} +sem_LeftHandSide :: LeftHandSide -> T_LeftHandSide +sem_LeftHandSide ( LeftHandSide_Function range_ name_ patterns_ ) = sem_LeftHandSide_Function ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_LeftHandSide ( LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ ) = sem_LeftHandSide_Infix ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name operator_ ) ( sem_Pattern rightPattern_ ) +sem_LeftHandSide ( LeftHandSide_Parenthesized range_ lefthandside_ patterns_ ) = sem_LeftHandSide_Parenthesized ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_Patterns patterns_ ) + +-- semantic domain +newtype T_LeftHandSide = T_LeftHandSide { + attach_T_LeftHandSide :: Identity (T_LeftHandSide_s86 ) + } +newtype T_LeftHandSide_s86 = C_LeftHandSide_s86 { + inv_LeftHandSide_s86 :: (T_LeftHandSide_v85 ) + } +data T_LeftHandSide_s87 = C_LeftHandSide_s87 +type T_LeftHandSide_v85 = (T_LeftHandSide_vIn85 ) -> (T_LeftHandSide_vOut85 ) +data T_LeftHandSide_vIn85 = T_LeftHandSide_vIn85 +data T_LeftHandSide_vOut85 = T_LeftHandSide_vOut85 (LeftHandSide) +{-# NOINLINE sem_LeftHandSide_Function #-} +sem_LeftHandSide_Function :: T_Range -> T_Name -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Function arg_range_ arg_name_ arg_patterns_ = T_LeftHandSide (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_LeftHandSide_v85 + v85 = \ (T_LeftHandSide_vIn85 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX125 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_Patterns_vOut124 _patternsIself) = inv_Patterns_s125 _patternsX125 (T_Patterns_vIn124 ) + _self = rule207 _nameIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule208 _self + __result_ = T_LeftHandSide_vOut85 _lhsOself + in __result_ ) + in C_LeftHandSide_s86 v85 + {-# INLINE rule207 #-} + rule207 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Function _rangeIself _nameIself _patternsIself + {-# INLINE rule208 #-} + rule208 = \ _self -> + _self +{-# NOINLINE sem_LeftHandSide_Infix #-} +sem_LeftHandSide_Infix :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_LeftHandSide +sem_LeftHandSide_Infix arg_range_ arg_leftPattern_ arg_operator_ arg_rightPattern_ = T_LeftHandSide (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_LeftHandSide_v85 + v85 = \ (T_LeftHandSide_vIn85 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _operatorX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_operator_)) + _rightPatternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Pattern_vOut121 _leftPatternIself) = inv_Pattern_s122 _leftPatternX122 (T_Pattern_vIn121 ) + (T_Name_vOut115 _operatorIself) = inv_Name_s116 _operatorX116 (T_Name_vIn115 ) + (T_Pattern_vOut121 _rightPatternIself) = inv_Pattern_s122 _rightPatternX122 (T_Pattern_vIn121 ) + _self = rule209 _leftPatternIself _operatorIself _rangeIself _rightPatternIself + _lhsOself :: LeftHandSide + _lhsOself = rule210 _self + __result_ = T_LeftHandSide_vOut85 _lhsOself + in __result_ ) + in C_LeftHandSide_s86 v85 + {-# INLINE rule209 #-} + rule209 = \ ((_leftPatternIself) :: Pattern) ((_operatorIself) :: Name) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + LeftHandSide_Infix _rangeIself _leftPatternIself _operatorIself _rightPatternIself + {-# INLINE rule210 #-} + rule210 = \ _self -> + _self +{-# NOINLINE sem_LeftHandSide_Parenthesized #-} +sem_LeftHandSide_Parenthesized :: T_Range -> T_LeftHandSide -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Parenthesized arg_range_ arg_lefthandside_ arg_patterns_ = T_LeftHandSide (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_LeftHandSide_v85 + v85 = \ (T_LeftHandSide_vIn85 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX86 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _patternsX125 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_LeftHandSide_vOut85 _lefthandsideIself) = inv_LeftHandSide_s86 _lefthandsideX86 (T_LeftHandSide_vIn85 ) + (T_Patterns_vOut124 _patternsIself) = inv_Patterns_s125 _patternsX125 (T_Patterns_vIn124 ) + _self = rule211 _lefthandsideIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule212 _self + __result_ = T_LeftHandSide_vOut85 _lhsOself + in __result_ ) + in C_LeftHandSide_s86 v85 + {-# INLINE rule211 #-} + rule211 = \ ((_lefthandsideIself) :: LeftHandSide) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Parenthesized _rangeIself _lefthandsideIself _patternsIself + {-# INLINE rule212 #-} + rule212 = \ _self -> + _self + +-- Literal ----------------------------------------------------- +-- wrapper +data Inh_Literal = Inh_Literal { } +data Syn_Literal = Syn_Literal { self_Syn_Literal :: (Literal) } +{-# INLINABLE wrap_Literal #-} +wrap_Literal :: T_Literal -> Inh_Literal -> (Syn_Literal ) +wrap_Literal (T_Literal act) (Inh_Literal ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Literal_vIn88 + (T_Literal_vOut88 _lhsOself) <- return (inv_Literal_s89 sem arg) + return (Syn_Literal _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Literal #-} +sem_Literal :: Literal -> T_Literal +sem_Literal ( Literal_Int range_ value_ ) = sem_Literal_Int ( sem_Range range_ ) value_ +sem_Literal ( Literal_Char range_ value_ ) = sem_Literal_Char ( sem_Range range_ ) value_ +sem_Literal ( Literal_Float range_ value_ ) = sem_Literal_Float ( sem_Range range_ ) value_ +sem_Literal ( Literal_String range_ value_ ) = sem_Literal_String ( sem_Range range_ ) value_ + +-- semantic domain +newtype T_Literal = T_Literal { + attach_T_Literal :: Identity (T_Literal_s89 ) + } +newtype T_Literal_s89 = C_Literal_s89 { + inv_Literal_s89 :: (T_Literal_v88 ) + } +data T_Literal_s90 = C_Literal_s90 +type T_Literal_v88 = (T_Literal_vIn88 ) -> (T_Literal_vOut88 ) +data T_Literal_vIn88 = T_Literal_vIn88 +data T_Literal_vOut88 = T_Literal_vOut88 (Literal) +{-# NOINLINE sem_Literal_Int #-} +sem_Literal_Int :: T_Range -> (String) -> T_Literal +sem_Literal_Int arg_range_ arg_value_ = T_Literal (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_Literal_v88 + v88 = \ (T_Literal_vIn88 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule213 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule214 _self + __result_ = T_Literal_vOut88 _lhsOself + in __result_ ) + in C_Literal_s89 v88 + {-# INLINE rule213 #-} + rule213 = \ ((_rangeIself) :: Range) value_ -> + Literal_Int _rangeIself value_ + {-# INLINE rule214 #-} + rule214 = \ _self -> + _self +{-# NOINLINE sem_Literal_Char #-} +sem_Literal_Char :: T_Range -> (String) -> T_Literal +sem_Literal_Char arg_range_ arg_value_ = T_Literal (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_Literal_v88 + v88 = \ (T_Literal_vIn88 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule215 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule216 _self + __result_ = T_Literal_vOut88 _lhsOself + in __result_ ) + in C_Literal_s89 v88 + {-# INLINE rule215 #-} + rule215 = \ ((_rangeIself) :: Range) value_ -> + Literal_Char _rangeIself value_ + {-# INLINE rule216 #-} + rule216 = \ _self -> + _self +{-# NOINLINE sem_Literal_Float #-} +sem_Literal_Float :: T_Range -> (String) -> T_Literal +sem_Literal_Float arg_range_ arg_value_ = T_Literal (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_Literal_v88 + v88 = \ (T_Literal_vIn88 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule217 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule218 _self + __result_ = T_Literal_vOut88 _lhsOself + in __result_ ) + in C_Literal_s89 v88 + {-# INLINE rule217 #-} + rule217 = \ ((_rangeIself) :: Range) value_ -> + Literal_Float _rangeIself value_ + {-# INLINE rule218 #-} + rule218 = \ _self -> + _self +{-# NOINLINE sem_Literal_String #-} +sem_Literal_String :: T_Range -> (String) -> T_Literal +sem_Literal_String arg_range_ arg_value_ = T_Literal (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_Literal_v88 + v88 = \ (T_Literal_vIn88 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule219 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule220 _self + __result_ = T_Literal_vOut88 _lhsOself + in __result_ ) + in C_Literal_s89 v88 + {-# INLINE rule219 #-} + rule219 = \ ((_rangeIself) :: Range) value_ -> + Literal_String _rangeIself value_ + {-# INLINE rule220 #-} + rule220 = \ _self -> + _self + +-- MaybeDeclarations ------------------------------------------- +-- wrapper +data Inh_MaybeDeclarations = Inh_MaybeDeclarations { } +data Syn_MaybeDeclarations = Syn_MaybeDeclarations { self_Syn_MaybeDeclarations :: (MaybeDeclarations) } +{-# INLINABLE wrap_MaybeDeclarations #-} +wrap_MaybeDeclarations :: T_MaybeDeclarations -> Inh_MaybeDeclarations -> (Syn_MaybeDeclarations ) +wrap_MaybeDeclarations (T_MaybeDeclarations act) (Inh_MaybeDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeDeclarations_vIn91 + (T_MaybeDeclarations_vOut91 _lhsOself) <- return (inv_MaybeDeclarations_s92 sem arg) + return (Syn_MaybeDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeDeclarations #-} +sem_MaybeDeclarations :: MaybeDeclarations -> T_MaybeDeclarations +sem_MaybeDeclarations ( MaybeDeclarations_Nothing ) = sem_MaybeDeclarations_Nothing +sem_MaybeDeclarations ( MaybeDeclarations_Just declarations_ ) = sem_MaybeDeclarations_Just ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_MaybeDeclarations = T_MaybeDeclarations { + attach_T_MaybeDeclarations :: Identity (T_MaybeDeclarations_s92 ) + } +newtype T_MaybeDeclarations_s92 = C_MaybeDeclarations_s92 { + inv_MaybeDeclarations_s92 :: (T_MaybeDeclarations_v91 ) + } +data T_MaybeDeclarations_s93 = C_MaybeDeclarations_s93 +type T_MaybeDeclarations_v91 = (T_MaybeDeclarations_vIn91 ) -> (T_MaybeDeclarations_vOut91 ) +data T_MaybeDeclarations_vIn91 = T_MaybeDeclarations_vIn91 +data T_MaybeDeclarations_vOut91 = T_MaybeDeclarations_vOut91 (MaybeDeclarations) +{-# NOINLINE sem_MaybeDeclarations_Nothing #-} +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = T_MaybeDeclarations (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeDeclarations_v91 + v91 = \ (T_MaybeDeclarations_vIn91 ) -> ( let + _self = rule221 () + _lhsOself :: MaybeDeclarations + _lhsOself = rule222 _self + __result_ = T_MaybeDeclarations_vOut91 _lhsOself + in __result_ ) + in C_MaybeDeclarations_s92 v91 + {-# INLINE rule221 #-} + rule221 = \ (_ :: ()) -> + MaybeDeclarations_Nothing + {-# INLINE rule222 #-} + rule222 = \ _self -> + _self +{-# NOINLINE sem_MaybeDeclarations_Just #-} +sem_MaybeDeclarations_Just :: T_Declarations -> T_MaybeDeclarations +sem_MaybeDeclarations_Just arg_declarations_ = T_MaybeDeclarations (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeDeclarations_v91 + v91 = \ (T_MaybeDeclarations_vIn91 ) -> ( let + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Declarations_vOut31 _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _self = rule223 _declarationsIself + _lhsOself :: MaybeDeclarations + _lhsOself = rule224 _self + __result_ = T_MaybeDeclarations_vOut91 _lhsOself + in __result_ ) + in C_MaybeDeclarations_s92 v91 + {-# INLINE rule223 #-} + rule223 = \ ((_declarationsIself) :: Declarations) -> + MaybeDeclarations_Just _declarationsIself + {-# INLINE rule224 #-} + rule224 = \ _self -> + _self + +-- MaybeExports ------------------------------------------------ +-- wrapper +data Inh_MaybeExports = Inh_MaybeExports { } +data Syn_MaybeExports = Syn_MaybeExports { self_Syn_MaybeExports :: (MaybeExports) } +{-# INLINABLE wrap_MaybeExports #-} +wrap_MaybeExports :: T_MaybeExports -> Inh_MaybeExports -> (Syn_MaybeExports ) +wrap_MaybeExports (T_MaybeExports act) (Inh_MaybeExports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExports_vIn94 + (T_MaybeExports_vOut94 _lhsOself) <- return (inv_MaybeExports_s95 sem arg) + return (Syn_MaybeExports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExports #-} +sem_MaybeExports :: MaybeExports -> T_MaybeExports +sem_MaybeExports ( MaybeExports_Nothing ) = sem_MaybeExports_Nothing +sem_MaybeExports ( MaybeExports_Just exports_ ) = sem_MaybeExports_Just ( sem_Exports exports_ ) + +-- semantic domain +newtype T_MaybeExports = T_MaybeExports { + attach_T_MaybeExports :: Identity (T_MaybeExports_s95 ) + } +newtype T_MaybeExports_s95 = C_MaybeExports_s95 { + inv_MaybeExports_s95 :: (T_MaybeExports_v94 ) + } +data T_MaybeExports_s96 = C_MaybeExports_s96 +type T_MaybeExports_v94 = (T_MaybeExports_vIn94 ) -> (T_MaybeExports_vOut94 ) +data T_MaybeExports_vIn94 = T_MaybeExports_vIn94 +data T_MaybeExports_vOut94 = T_MaybeExports_vOut94 (MaybeExports) +{-# NOINLINE sem_MaybeExports_Nothing #-} +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = T_MaybeExports (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExports_v94 + v94 = \ (T_MaybeExports_vIn94 ) -> ( let + _self = rule225 () + _lhsOself :: MaybeExports + _lhsOself = rule226 _self + __result_ = T_MaybeExports_vOut94 _lhsOself + in __result_ ) + in C_MaybeExports_s95 v94 + {-# INLINE rule225 #-} + rule225 = \ (_ :: ()) -> + MaybeExports_Nothing + {-# INLINE rule226 #-} + rule226 = \ _self -> + _self +{-# NOINLINE sem_MaybeExports_Just #-} +sem_MaybeExports_Just :: T_Exports -> T_MaybeExports +sem_MaybeExports_Just arg_exports_ = T_MaybeExports (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExports_v94 + v94 = \ (T_MaybeExports_vIn94 ) -> ( let + _exportsX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_exports_)) + (T_Exports_vOut37 _exportsIself) = inv_Exports_s38 _exportsX38 (T_Exports_vIn37 ) + _self = rule227 _exportsIself + _lhsOself :: MaybeExports + _lhsOself = rule228 _self + __result_ = T_MaybeExports_vOut94 _lhsOself + in __result_ ) + in C_MaybeExports_s95 v94 + {-# INLINE rule227 #-} + rule227 = \ ((_exportsIself) :: Exports) -> + MaybeExports_Just _exportsIself + {-# INLINE rule228 #-} + rule228 = \ _self -> + _self + +-- MaybeExpression --------------------------------------------- +-- wrapper +data Inh_MaybeExpression = Inh_MaybeExpression { } +data Syn_MaybeExpression = Syn_MaybeExpression { allVariables_Syn_MaybeExpression :: ([(Name,Entity)]), self_Syn_MaybeExpression :: (MaybeExpression) } +{-# INLINABLE wrap_MaybeExpression #-} +wrap_MaybeExpression :: T_MaybeExpression -> Inh_MaybeExpression -> (Syn_MaybeExpression ) +wrap_MaybeExpression (T_MaybeExpression act) (Inh_MaybeExpression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExpression_vIn97 + (T_MaybeExpression_vOut97 _lhsOallVariables _lhsOself) <- return (inv_MaybeExpression_s98 sem arg) + return (Syn_MaybeExpression _lhsOallVariables _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExpression #-} +sem_MaybeExpression :: MaybeExpression -> T_MaybeExpression +sem_MaybeExpression ( MaybeExpression_Nothing ) = sem_MaybeExpression_Nothing +sem_MaybeExpression ( MaybeExpression_Just expression_ ) = sem_MaybeExpression_Just ( sem_Expression expression_ ) + +-- semantic domain +newtype T_MaybeExpression = T_MaybeExpression { + attach_T_MaybeExpression :: Identity (T_MaybeExpression_s98 ) + } +newtype T_MaybeExpression_s98 = C_MaybeExpression_s98 { + inv_MaybeExpression_s98 :: (T_MaybeExpression_v97 ) + } +data T_MaybeExpression_s99 = C_MaybeExpression_s99 +type T_MaybeExpression_v97 = (T_MaybeExpression_vIn97 ) -> (T_MaybeExpression_vOut97 ) +data T_MaybeExpression_vIn97 = T_MaybeExpression_vIn97 +data T_MaybeExpression_vOut97 = T_MaybeExpression_vOut97 ([(Name,Entity)]) (MaybeExpression) +{-# NOINLINE sem_MaybeExpression_Nothing #-} +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = T_MaybeExpression (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeExpression_v97 + v97 = \ (T_MaybeExpression_vIn97 ) -> ( let + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule229 () + _self = rule230 () + _lhsOself :: MaybeExpression + _lhsOself = rule231 _self + __result_ = T_MaybeExpression_vOut97 _lhsOallVariables _lhsOself + in __result_ ) + in C_MaybeExpression_s98 v97 + {-# INLINE rule229 #-} + rule229 = \ (_ :: ()) -> + [] + {-# INLINE rule230 #-} + rule230 = \ (_ :: ()) -> + MaybeExpression_Nothing + {-# INLINE rule231 #-} + rule231 = \ _self -> + _self +{-# NOINLINE sem_MaybeExpression_Just #-} +sem_MaybeExpression_Just :: T_Expression -> T_MaybeExpression +sem_MaybeExpression_Just arg_expression_ = T_MaybeExpression (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeExpression_v97 + v97 = \ (T_MaybeExpression_vIn97 ) -> ( let + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _lhsOallVariables :: [(Name,Entity)] + _lhsOallVariables = rule232 _expressionIallVariables + _self = rule233 _expressionIself + _lhsOself :: MaybeExpression + _lhsOself = rule234 _self + __result_ = T_MaybeExpression_vOut97 _lhsOallVariables _lhsOself + in __result_ ) + in C_MaybeExpression_s98 v97 + {-# INLINE rule232 #-} + rule232 = \ ((_expressionIallVariables) :: [(Name,Entity)]) -> + _expressionIallVariables + {-# INLINE rule233 #-} + rule233 = \ ((_expressionIself) :: Expression) -> + MaybeExpression_Just _expressionIself + {-# INLINE rule234 #-} + rule234 = \ _self -> + _self + +-- MaybeImportSpecification ------------------------------------ +-- wrapper +data Inh_MaybeImportSpecification = Inh_MaybeImportSpecification { } +data Syn_MaybeImportSpecification = Syn_MaybeImportSpecification { self_Syn_MaybeImportSpecification :: (MaybeImportSpecification) } +{-# INLINABLE wrap_MaybeImportSpecification #-} +wrap_MaybeImportSpecification :: T_MaybeImportSpecification -> Inh_MaybeImportSpecification -> (Syn_MaybeImportSpecification ) +wrap_MaybeImportSpecification (T_MaybeImportSpecification act) (Inh_MaybeImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeImportSpecification_vIn100 + (T_MaybeImportSpecification_vOut100 _lhsOself) <- return (inv_MaybeImportSpecification_s101 sem arg) + return (Syn_MaybeImportSpecification _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeImportSpecification #-} +sem_MaybeImportSpecification :: MaybeImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification ( MaybeImportSpecification_Nothing ) = sem_MaybeImportSpecification_Nothing +sem_MaybeImportSpecification ( MaybeImportSpecification_Just importspecification_ ) = sem_MaybeImportSpecification_Just ( sem_ImportSpecification importspecification_ ) + +-- semantic domain +newtype T_MaybeImportSpecification = T_MaybeImportSpecification { + attach_T_MaybeImportSpecification :: Identity (T_MaybeImportSpecification_s101 ) + } +newtype T_MaybeImportSpecification_s101 = C_MaybeImportSpecification_s101 { + inv_MaybeImportSpecification_s101 :: (T_MaybeImportSpecification_v100 ) + } +data T_MaybeImportSpecification_s102 = C_MaybeImportSpecification_s102 +type T_MaybeImportSpecification_v100 = (T_MaybeImportSpecification_vIn100 ) -> (T_MaybeImportSpecification_vOut100 ) +data T_MaybeImportSpecification_vIn100 = T_MaybeImportSpecification_vIn100 +data T_MaybeImportSpecification_vOut100 = T_MaybeImportSpecification_vOut100 (MaybeImportSpecification) +{-# NOINLINE sem_MaybeImportSpecification_Nothing #-} +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = T_MaybeImportSpecification (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeImportSpecification_v100 + v100 = \ (T_MaybeImportSpecification_vIn100 ) -> ( let + _self = rule235 () + _lhsOself :: MaybeImportSpecification + _lhsOself = rule236 _self + __result_ = T_MaybeImportSpecification_vOut100 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s101 v100 + {-# INLINE rule235 #-} + rule235 = \ (_ :: ()) -> + MaybeImportSpecification_Nothing + {-# INLINE rule236 #-} + rule236 = \ _self -> + _self +{-# NOINLINE sem_MaybeImportSpecification_Just #-} +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification_Just arg_importspecification_ = T_MaybeImportSpecification (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeImportSpecification_v100 + v100 = \ (T_MaybeImportSpecification_vIn100 ) -> ( let + _importspecificationX77 = Control.Monad.Identity.runIdentity (attach_T_ImportSpecification (arg_importspecification_)) + (T_ImportSpecification_vOut76 _importspecificationIself) = inv_ImportSpecification_s77 _importspecificationX77 (T_ImportSpecification_vIn76 ) + _self = rule237 _importspecificationIself + _lhsOself :: MaybeImportSpecification + _lhsOself = rule238 _self + __result_ = T_MaybeImportSpecification_vOut100 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s101 v100 + {-# INLINE rule237 #-} + rule237 = \ ((_importspecificationIself) :: ImportSpecification) -> + MaybeImportSpecification_Just _importspecificationIself + {-# INLINE rule238 #-} + rule238 = \ _self -> + _self + +-- MaybeInt ---------------------------------------------------- +-- wrapper +data Inh_MaybeInt = Inh_MaybeInt { } +data Syn_MaybeInt = Syn_MaybeInt { self_Syn_MaybeInt :: (MaybeInt) } +{-# INLINABLE wrap_MaybeInt #-} +wrap_MaybeInt :: T_MaybeInt -> Inh_MaybeInt -> (Syn_MaybeInt ) +wrap_MaybeInt (T_MaybeInt act) (Inh_MaybeInt ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeInt_vIn103 + (T_MaybeInt_vOut103 _lhsOself) <- return (inv_MaybeInt_s104 sem arg) + return (Syn_MaybeInt _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeInt #-} +sem_MaybeInt :: MaybeInt -> T_MaybeInt +sem_MaybeInt ( MaybeInt_Nothing ) = sem_MaybeInt_Nothing +sem_MaybeInt ( MaybeInt_Just int_ ) = sem_MaybeInt_Just int_ + +-- semantic domain +newtype T_MaybeInt = T_MaybeInt { + attach_T_MaybeInt :: Identity (T_MaybeInt_s104 ) + } +newtype T_MaybeInt_s104 = C_MaybeInt_s104 { + inv_MaybeInt_s104 :: (T_MaybeInt_v103 ) + } +data T_MaybeInt_s105 = C_MaybeInt_s105 +type T_MaybeInt_v103 = (T_MaybeInt_vIn103 ) -> (T_MaybeInt_vOut103 ) +data T_MaybeInt_vIn103 = T_MaybeInt_vIn103 +data T_MaybeInt_vOut103 = T_MaybeInt_vOut103 (MaybeInt) +{-# NOINLINE sem_MaybeInt_Nothing #-} +sem_MaybeInt_Nothing :: T_MaybeInt +sem_MaybeInt_Nothing = T_MaybeInt (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeInt_v103 + v103 = \ (T_MaybeInt_vIn103 ) -> ( let + _self = rule239 () + _lhsOself :: MaybeInt + _lhsOself = rule240 _self + __result_ = T_MaybeInt_vOut103 _lhsOself + in __result_ ) + in C_MaybeInt_s104 v103 + {-# INLINE rule239 #-} + rule239 = \ (_ :: ()) -> + MaybeInt_Nothing + {-# INLINE rule240 #-} + rule240 = \ _self -> + _self +{-# NOINLINE sem_MaybeInt_Just #-} +sem_MaybeInt_Just :: (Int) -> T_MaybeInt +sem_MaybeInt_Just arg_int_ = T_MaybeInt (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeInt_v103 + v103 = \ (T_MaybeInt_vIn103 ) -> ( let + _self = rule241 arg_int_ + _lhsOself :: MaybeInt + _lhsOself = rule242 _self + __result_ = T_MaybeInt_vOut103 _lhsOself + in __result_ ) + in C_MaybeInt_s104 v103 + {-# INLINE rule241 #-} + rule241 = \ int_ -> + MaybeInt_Just int_ + {-# INLINE rule242 #-} + rule242 = \ _self -> + _self + +-- MaybeName --------------------------------------------------- +-- wrapper +data Inh_MaybeName = Inh_MaybeName { } +data Syn_MaybeName = Syn_MaybeName { self_Syn_MaybeName :: (MaybeName) } +{-# INLINABLE wrap_MaybeName #-} +wrap_MaybeName :: T_MaybeName -> Inh_MaybeName -> (Syn_MaybeName ) +wrap_MaybeName (T_MaybeName act) (Inh_MaybeName ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeName_vIn106 + (T_MaybeName_vOut106 _lhsOself) <- return (inv_MaybeName_s107 sem arg) + return (Syn_MaybeName _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeName #-} +sem_MaybeName :: MaybeName -> T_MaybeName +sem_MaybeName ( MaybeName_Nothing ) = sem_MaybeName_Nothing +sem_MaybeName ( MaybeName_Just name_ ) = sem_MaybeName_Just ( sem_Name name_ ) + +-- semantic domain +newtype T_MaybeName = T_MaybeName { + attach_T_MaybeName :: Identity (T_MaybeName_s107 ) + } +newtype T_MaybeName_s107 = C_MaybeName_s107 { + inv_MaybeName_s107 :: (T_MaybeName_v106 ) + } +data T_MaybeName_s108 = C_MaybeName_s108 +type T_MaybeName_v106 = (T_MaybeName_vIn106 ) -> (T_MaybeName_vOut106 ) +data T_MaybeName_vIn106 = T_MaybeName_vIn106 +data T_MaybeName_vOut106 = T_MaybeName_vOut106 (MaybeName) +{-# NOINLINE sem_MaybeName_Nothing #-} +sem_MaybeName_Nothing :: T_MaybeName +sem_MaybeName_Nothing = T_MaybeName (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeName_v106 + v106 = \ (T_MaybeName_vIn106 ) -> ( let + _self = rule243 () + _lhsOself :: MaybeName + _lhsOself = rule244 _self + __result_ = T_MaybeName_vOut106 _lhsOself + in __result_ ) + in C_MaybeName_s107 v106 + {-# INLINE rule243 #-} + rule243 = \ (_ :: ()) -> + MaybeName_Nothing + {-# INLINE rule244 #-} + rule244 = \ _self -> + _self +{-# NOINLINE sem_MaybeName_Just #-} +sem_MaybeName_Just :: T_Name -> T_MaybeName +sem_MaybeName_Just arg_name_ = T_MaybeName (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeName_v106 + v106 = \ (T_MaybeName_vIn106 ) -> ( let + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _self = rule245 _nameIself + _lhsOself :: MaybeName + _lhsOself = rule246 _self + __result_ = T_MaybeName_vOut106 _lhsOself + in __result_ ) + in C_MaybeName_s107 v106 + {-# INLINE rule245 #-} + rule245 = \ ((_nameIself) :: Name) -> + MaybeName_Just _nameIself + {-# INLINE rule246 #-} + rule246 = \ _self -> + _self + +-- MaybeNames -------------------------------------------------- +-- wrapper +data Inh_MaybeNames = Inh_MaybeNames { } +data Syn_MaybeNames = Syn_MaybeNames { self_Syn_MaybeNames :: (MaybeNames) } +{-# INLINABLE wrap_MaybeNames #-} +wrap_MaybeNames :: T_MaybeNames -> Inh_MaybeNames -> (Syn_MaybeNames ) +wrap_MaybeNames (T_MaybeNames act) (Inh_MaybeNames ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeNames_vIn109 + (T_MaybeNames_vOut109 _lhsOself) <- return (inv_MaybeNames_s110 sem arg) + return (Syn_MaybeNames _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeNames #-} +sem_MaybeNames :: MaybeNames -> T_MaybeNames +sem_MaybeNames ( MaybeNames_Nothing ) = sem_MaybeNames_Nothing +sem_MaybeNames ( MaybeNames_Just names_ ) = sem_MaybeNames_Just ( sem_Names names_ ) + +-- semantic domain +newtype T_MaybeNames = T_MaybeNames { + attach_T_MaybeNames :: Identity (T_MaybeNames_s110 ) + } +newtype T_MaybeNames_s110 = C_MaybeNames_s110 { + inv_MaybeNames_s110 :: (T_MaybeNames_v109 ) + } +data T_MaybeNames_s111 = C_MaybeNames_s111 +type T_MaybeNames_v109 = (T_MaybeNames_vIn109 ) -> (T_MaybeNames_vOut109 ) +data T_MaybeNames_vIn109 = T_MaybeNames_vIn109 +data T_MaybeNames_vOut109 = T_MaybeNames_vOut109 (MaybeNames) +{-# NOINLINE sem_MaybeNames_Nothing #-} +sem_MaybeNames_Nothing :: T_MaybeNames +sem_MaybeNames_Nothing = T_MaybeNames (return st110) where + {-# NOINLINE st110 #-} + st110 = let + v109 :: T_MaybeNames_v109 + v109 = \ (T_MaybeNames_vIn109 ) -> ( let + _self = rule247 () + _lhsOself :: MaybeNames + _lhsOself = rule248 _self + __result_ = T_MaybeNames_vOut109 _lhsOself + in __result_ ) + in C_MaybeNames_s110 v109 + {-# INLINE rule247 #-} + rule247 = \ (_ :: ()) -> + MaybeNames_Nothing + {-# INLINE rule248 #-} + rule248 = \ _self -> + _self +{-# NOINLINE sem_MaybeNames_Just #-} +sem_MaybeNames_Just :: T_Names -> T_MaybeNames +sem_MaybeNames_Just arg_names_ = T_MaybeNames (return st110) where + {-# NOINLINE st110 #-} + st110 = let + v109 :: T_MaybeNames_v109 + v109 = \ (T_MaybeNames_vIn109 ) -> ( let + _namesX119 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + (T_Names_vOut118 _namesIself) = inv_Names_s119 _namesX119 (T_Names_vIn118 ) + _self = rule249 _namesIself + _lhsOself :: MaybeNames + _lhsOself = rule250 _self + __result_ = T_MaybeNames_vOut109 _lhsOself + in __result_ ) + in C_MaybeNames_s110 v109 + {-# INLINE rule249 #-} + rule249 = \ ((_namesIself) :: Names) -> + MaybeNames_Just _namesIself + {-# INLINE rule250 #-} + rule250 = \ _self -> + _self + +-- Module ------------------------------------------------------ +-- wrapper +data Inh_Module = Inh_Module { } +data Syn_Module = Syn_Module { self_Syn_Module :: (Module) } +{-# INLINABLE wrap_Module #-} +wrap_Module :: T_Module -> Inh_Module -> (Syn_Module ) +wrap_Module (T_Module act) (Inh_Module ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Module_vIn112 + (T_Module_vOut112 _lhsOself) <- return (inv_Module_s113 sem arg) + return (Syn_Module _lhsOself) + ) + +-- cata +{-# INLINE sem_Module #-} +sem_Module :: Module -> T_Module +sem_Module ( Module_Module range_ name_ exports_ body_ ) = sem_Module_Module ( sem_Range range_ ) ( sem_MaybeName name_ ) ( sem_MaybeExports exports_ ) ( sem_Body body_ ) + +-- semantic domain +newtype T_Module = T_Module { + attach_T_Module :: Identity (T_Module_s113 ) + } +newtype T_Module_s113 = C_Module_s113 { + inv_Module_s113 :: (T_Module_v112 ) + } +data T_Module_s114 = C_Module_s114 +type T_Module_v112 = (T_Module_vIn112 ) -> (T_Module_vOut112 ) +data T_Module_vIn112 = T_Module_vIn112 +data T_Module_vOut112 = T_Module_vOut112 (Module) +{-# NOINLINE sem_Module_Module #-} +sem_Module_Module :: T_Range -> T_MaybeName -> T_MaybeExports -> T_Body -> T_Module +sem_Module_Module arg_range_ arg_name_ arg_exports_ arg_body_ = T_Module (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Module_v112 + v112 = \ (T_Module_vIn112 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_name_)) + _exportsX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExports (arg_exports_)) + _bodyX14 = Control.Monad.Identity.runIdentity (attach_T_Body (arg_body_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_MaybeName_vOut106 _nameIself) = inv_MaybeName_s107 _nameX107 (T_MaybeName_vIn106 ) + (T_MaybeExports_vOut94 _exportsIself) = inv_MaybeExports_s95 _exportsX95 (T_MaybeExports_vIn94 ) + (T_Body_vOut13 _bodyIself) = inv_Body_s14 _bodyX14 (T_Body_vIn13 ) + _self = rule251 _bodyIself _exportsIself _nameIself _rangeIself + _lhsOself :: Module + _lhsOself = rule252 _self + __result_ = T_Module_vOut112 _lhsOself + in __result_ ) + in C_Module_s113 v112 + {-# INLINE rule251 #-} + rule251 = \ ((_bodyIself) :: Body) ((_exportsIself) :: MaybeExports) ((_nameIself) :: MaybeName) ((_rangeIself) :: Range) -> + Module_Module _rangeIself _nameIself _exportsIself _bodyIself + {-# INLINE rule252 #-} + rule252 = \ _self -> + _self + +-- Name -------------------------------------------------------- +-- wrapper +data Inh_Name = Inh_Name { } +data Syn_Name = Syn_Name { self_Syn_Name :: (Name) } +{-# INLINABLE wrap_Name #-} +wrap_Name :: T_Name -> Inh_Name -> (Syn_Name ) +wrap_Name (T_Name act) (Inh_Name ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Name_vIn115 + (T_Name_vOut115 _lhsOself) <- return (inv_Name_s116 sem arg) + return (Syn_Name _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Name #-} +sem_Name :: Name -> T_Name +sem_Name ( Name_Identifier range_ module_ name_ ) = sem_Name_Identifier ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Operator range_ module_ name_ ) = sem_Name_Operator ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Special range_ module_ name_ ) = sem_Name_Special ( sem_Range range_ ) ( sem_Strings module_ ) name_ + +-- semantic domain +newtype T_Name = T_Name { + attach_T_Name :: Identity (T_Name_s116 ) + } +newtype T_Name_s116 = C_Name_s116 { + inv_Name_s116 :: (T_Name_v115 ) + } +data T_Name_s117 = C_Name_s117 +type T_Name_v115 = (T_Name_vIn115 ) -> (T_Name_vOut115 ) +data T_Name_vIn115 = T_Name_vIn115 +data T_Name_vOut115 = T_Name_vOut115 (Name) +{-# NOINLINE sem_Name_Identifier #-} +sem_Name_Identifier :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Identifier arg_range_ arg_module_ arg_name_ = T_Name (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Name_v115 + v115 = \ (T_Name_vIn115 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX170 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Strings_vOut169 _moduleIself) = inv_Strings_s170 _moduleX170 (T_Strings_vIn169 ) + _self = rule253 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule254 _self + __result_ = T_Name_vOut115 _lhsOself + in __result_ ) + in C_Name_s116 v115 + {-# INLINE rule253 #-} + rule253 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Identifier _rangeIself _moduleIself name_ + {-# INLINE rule254 #-} + rule254 = \ _self -> + _self +{-# NOINLINE sem_Name_Operator #-} +sem_Name_Operator :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Operator arg_range_ arg_module_ arg_name_ = T_Name (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Name_v115 + v115 = \ (T_Name_vIn115 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX170 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Strings_vOut169 _moduleIself) = inv_Strings_s170 _moduleX170 (T_Strings_vIn169 ) + _self = rule255 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule256 _self + __result_ = T_Name_vOut115 _lhsOself + in __result_ ) + in C_Name_s116 v115 + {-# INLINE rule255 #-} + rule255 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Operator _rangeIself _moduleIself name_ + {-# INLINE rule256 #-} + rule256 = \ _self -> + _self +{-# NOINLINE sem_Name_Special #-} +sem_Name_Special :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Special arg_range_ arg_module_ arg_name_ = T_Name (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Name_v115 + v115 = \ (T_Name_vIn115 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX170 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Strings_vOut169 _moduleIself) = inv_Strings_s170 _moduleX170 (T_Strings_vIn169 ) + _self = rule257 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule258 _self + __result_ = T_Name_vOut115 _lhsOself + in __result_ ) + in C_Name_s116 v115 + {-# INLINE rule257 #-} + rule257 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Special _rangeIself _moduleIself name_ + {-# INLINE rule258 #-} + rule258 = \ _self -> + _self + +-- Names ------------------------------------------------------- +-- wrapper +data Inh_Names = Inh_Names { } +data Syn_Names = Syn_Names { self_Syn_Names :: (Names) } +{-# INLINABLE wrap_Names #-} +wrap_Names :: T_Names -> Inh_Names -> (Syn_Names ) +wrap_Names (T_Names act) (Inh_Names ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Names_vIn118 + (T_Names_vOut118 _lhsOself) <- return (inv_Names_s119 sem arg) + return (Syn_Names _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Names #-} +sem_Names :: Names -> T_Names +sem_Names list = Prelude.foldr sem_Names_Cons sem_Names_Nil (Prelude.map sem_Name list) + +-- semantic domain +newtype T_Names = T_Names { + attach_T_Names :: Identity (T_Names_s119 ) + } +newtype T_Names_s119 = C_Names_s119 { + inv_Names_s119 :: (T_Names_v118 ) + } +data T_Names_s120 = C_Names_s120 +type T_Names_v118 = (T_Names_vIn118 ) -> (T_Names_vOut118 ) +data T_Names_vIn118 = T_Names_vIn118 +data T_Names_vOut118 = T_Names_vOut118 (Names) +{-# NOINLINE sem_Names_Cons #-} +sem_Names_Cons :: T_Name -> T_Names -> T_Names +sem_Names_Cons arg_hd_ arg_tl_ = T_Names (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Names_v118 + v118 = \ (T_Names_vIn118 ) -> ( let + _hdX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_hd_)) + _tlX119 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_tl_)) + (T_Name_vOut115 _hdIself) = inv_Name_s116 _hdX116 (T_Name_vIn115 ) + (T_Names_vOut118 _tlIself) = inv_Names_s119 _tlX119 (T_Names_vIn118 ) + _self = rule259 _hdIself _tlIself + _lhsOself :: Names + _lhsOself = rule260 _self + __result_ = T_Names_vOut118 _lhsOself + in __result_ ) + in C_Names_s119 v118 + {-# INLINE rule259 #-} + rule259 = \ ((_hdIself) :: Name) ((_tlIself) :: Names) -> + (:) _hdIself _tlIself + {-# INLINE rule260 #-} + rule260 = \ _self -> + _self +{-# NOINLINE sem_Names_Nil #-} +sem_Names_Nil :: T_Names +sem_Names_Nil = T_Names (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Names_v118 + v118 = \ (T_Names_vIn118 ) -> ( let + _self = rule261 () + _lhsOself :: Names + _lhsOself = rule262 _self + __result_ = T_Names_vOut118 _lhsOself + in __result_ ) + in C_Names_s119 v118 + {-# INLINE rule261 #-} + rule261 = \ (_ :: ()) -> + [] + {-# INLINE rule262 #-} + rule262 = \ _self -> + _self + +-- Pattern ----------------------------------------------------- +-- wrapper +data Inh_Pattern = Inh_Pattern { } +data Syn_Pattern = Syn_Pattern { self_Syn_Pattern :: (Pattern) } +{-# INLINABLE wrap_Pattern #-} +wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) +wrap_Pattern (T_Pattern act) (Inh_Pattern ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Pattern_vIn121 + (T_Pattern_vOut121 _lhsOself) <- return (inv_Pattern_s122 sem arg) + return (Syn_Pattern _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Pattern #-} +sem_Pattern :: Pattern -> T_Pattern +sem_Pattern ( Pattern_Hole range_ id_ ) = sem_Pattern_Hole ( sem_Range range_ ) id_ +sem_Pattern ( Pattern_Literal range_ literal_ ) = sem_Pattern_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_Variable range_ name_ ) = sem_Pattern_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Pattern ( Pattern_Constructor range_ name_ patterns_ ) = sem_Pattern_Constructor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Parenthesized range_ pattern_ ) = sem_Pattern_Parenthesized ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ ) = sem_Pattern_InfixConstructor ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name constructorOperator_ ) ( sem_Pattern rightPattern_ ) +sem_Pattern ( Pattern_List range_ patterns_ ) = sem_Pattern_List ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Tuple range_ patterns_ ) = sem_Pattern_Tuple ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Record range_ name_ recordPatternBindings_ ) = sem_Pattern_Record ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordPatternBindings recordPatternBindings_ ) +sem_Pattern ( Pattern_Negate range_ literal_ ) = sem_Pattern_Negate ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_As range_ name_ pattern_ ) = sem_Pattern_As ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Wildcard range_ ) = sem_Pattern_Wildcard ( sem_Range range_ ) +sem_Pattern ( Pattern_Irrefutable range_ pattern_ ) = sem_Pattern_Irrefutable ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Successor range_ name_ literal_ ) = sem_Pattern_Successor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_NegateFloat range_ literal_ ) = sem_Pattern_NegateFloat ( sem_Range range_ ) ( sem_Literal literal_ ) + +-- semantic domain +newtype T_Pattern = T_Pattern { + attach_T_Pattern :: Identity (T_Pattern_s122 ) + } +newtype T_Pattern_s122 = C_Pattern_s122 { + inv_Pattern_s122 :: (T_Pattern_v121 ) + } +data T_Pattern_s123 = C_Pattern_s123 +type T_Pattern_v121 = (T_Pattern_vIn121 ) -> (T_Pattern_vOut121 ) +data T_Pattern_vIn121 = T_Pattern_vIn121 +data T_Pattern_vOut121 = T_Pattern_vOut121 (Pattern) +{-# NOINLINE sem_Pattern_Hole #-} +sem_Pattern_Hole :: T_Range -> (Integer) -> T_Pattern +sem_Pattern_Hole arg_range_ arg_id_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule263 _rangeIself arg_id_ + _lhsOself :: Pattern + _lhsOself = rule264 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule263 #-} + rule263 = \ ((_rangeIself) :: Range) id_ -> + Pattern_Hole _rangeIself id_ + {-# INLINE rule264 #-} + rule264 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Literal #-} +sem_Pattern_Literal :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Literal arg_range_ arg_literal_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX89 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Literal_vOut88 _literalIself) = inv_Literal_s89 _literalX89 (T_Literal_vIn88 ) + _self = rule265 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule266 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule265 #-} + rule265 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Literal _rangeIself _literalIself + {-# INLINE rule266 #-} + rule266 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Variable #-} +sem_Pattern_Variable :: T_Range -> T_Name -> T_Pattern +sem_Pattern_Variable arg_range_ arg_name_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _self = rule267 _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule268 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule267 #-} + rule267 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Variable _rangeIself _nameIself + {-# INLINE rule268 #-} + rule268 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Constructor #-} +sem_Pattern_Constructor :: T_Range -> T_Name -> T_Patterns -> T_Pattern +sem_Pattern_Constructor arg_range_ arg_name_ arg_patterns_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX125 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_Patterns_vOut124 _patternsIself) = inv_Patterns_s125 _patternsX125 (T_Patterns_vIn124 ) + _self = rule269 _nameIself _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule270 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule269 #-} + rule269 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Constructor _rangeIself _nameIself _patternsIself + {-# INLINE rule270 #-} + rule270 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Parenthesized #-} +sem_Pattern_Parenthesized :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Parenthesized arg_range_ arg_pattern_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Pattern_vOut121 _patternIself) = inv_Pattern_s122 _patternX122 (T_Pattern_vIn121 ) + _self = rule271 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule272 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule271 #-} + rule271 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Parenthesized _rangeIself _patternIself + {-# INLINE rule272 #-} + rule272 = \ _self -> + _self +{-# NOINLINE sem_Pattern_InfixConstructor #-} +sem_Pattern_InfixConstructor :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_InfixConstructor arg_range_ arg_leftPattern_ arg_constructorOperator_ arg_rightPattern_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _constructorOperatorX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightPatternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Pattern_vOut121 _leftPatternIself) = inv_Pattern_s122 _leftPatternX122 (T_Pattern_vIn121 ) + (T_Name_vOut115 _constructorOperatorIself) = inv_Name_s116 _constructorOperatorX116 (T_Name_vIn115 ) + (T_Pattern_vOut121 _rightPatternIself) = inv_Pattern_s122 _rightPatternX122 (T_Pattern_vIn121 ) + _self = rule273 _constructorOperatorIself _leftPatternIself _rangeIself _rightPatternIself + _lhsOself :: Pattern + _lhsOself = rule274 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule273 #-} + rule273 = \ ((_constructorOperatorIself) :: Name) ((_leftPatternIself) :: Pattern) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + Pattern_InfixConstructor _rangeIself _leftPatternIself _constructorOperatorIself _rightPatternIself + {-# INLINE rule274 #-} + rule274 = \ _self -> + _self +{-# NOINLINE sem_Pattern_List #-} +sem_Pattern_List :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_List arg_range_ arg_patterns_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX125 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Patterns_vOut124 _patternsIself) = inv_Patterns_s125 _patternsX125 (T_Patterns_vIn124 ) + _self = rule275 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule276 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule275 #-} + rule275 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_List _rangeIself _patternsIself + {-# INLINE rule276 #-} + rule276 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Tuple #-} +sem_Pattern_Tuple :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_Tuple arg_range_ arg_patterns_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX125 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Patterns_vOut124 _patternsIself) = inv_Patterns_s125 _patternsX125 (T_Patterns_vIn124 ) + _self = rule277 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule278 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule277 #-} + rule277 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Tuple _rangeIself _patternsIself + {-# INLINE rule278 #-} + rule278 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Record #-} +sem_Pattern_Record :: T_Range -> T_Name -> T_RecordPatternBindings -> T_Pattern +sem_Pattern_Record arg_range_ arg_name_ arg_recordPatternBindings_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordPatternBindingsX149 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_recordPatternBindings_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_RecordPatternBindings_vOut148 _recordPatternBindingsIself) = inv_RecordPatternBindings_s149 _recordPatternBindingsX149 (T_RecordPatternBindings_vIn148 ) + _self = rule279 _nameIself _rangeIself _recordPatternBindingsIself + _lhsOself :: Pattern + _lhsOself = rule280 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule279 #-} + rule279 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordPatternBindingsIself) :: RecordPatternBindings) -> + Pattern_Record _rangeIself _nameIself _recordPatternBindingsIself + {-# INLINE rule280 #-} + rule280 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Negate #-} +sem_Pattern_Negate :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Negate arg_range_ arg_literal_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX89 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Literal_vOut88 _literalIself) = inv_Literal_s89 _literalX89 (T_Literal_vIn88 ) + _self = rule281 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule282 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule281 #-} + rule281 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Negate _rangeIself _literalIself + {-# INLINE rule282 #-} + rule282 = \ _self -> + _self +{-# NOINLINE sem_Pattern_As #-} +sem_Pattern_As :: T_Range -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_As arg_range_ arg_name_ arg_pattern_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_Pattern_vOut121 _patternIself) = inv_Pattern_s122 _patternX122 (T_Pattern_vIn121 ) + _self = rule283 _nameIself _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule284 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule283 #-} + rule283 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_As _rangeIself _nameIself _patternIself + {-# INLINE rule284 #-} + rule284 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Wildcard #-} +sem_Pattern_Wildcard :: T_Range -> T_Pattern +sem_Pattern_Wildcard arg_range_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule285 _rangeIself + _lhsOself :: Pattern + _lhsOself = rule286 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule285 #-} + rule285 = \ ((_rangeIself) :: Range) -> + Pattern_Wildcard _rangeIself + {-# INLINE rule286 #-} + rule286 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Irrefutable #-} +sem_Pattern_Irrefutable :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Irrefutable arg_range_ arg_pattern_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Pattern_vOut121 _patternIself) = inv_Pattern_s122 _patternX122 (T_Pattern_vIn121 ) + _self = rule287 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule288 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule287 #-} + rule287 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Irrefutable _rangeIself _patternIself + {-# INLINE rule288 #-} + rule288 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Successor #-} +sem_Pattern_Successor :: T_Range -> T_Name -> T_Literal -> T_Pattern +sem_Pattern_Successor arg_range_ arg_name_ arg_literal_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _literalX89 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_Literal_vOut88 _literalIself) = inv_Literal_s89 _literalX89 (T_Literal_vIn88 ) + _self = rule289 _literalIself _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule290 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule289 #-} + rule289 = \ ((_literalIself) :: Literal) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Successor _rangeIself _nameIself _literalIself + {-# INLINE rule290 #-} + rule290 = \ _self -> + _self +{-# NOINLINE sem_Pattern_NegateFloat #-} +sem_Pattern_NegateFloat :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_NegateFloat arg_range_ arg_literal_ = T_Pattern (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Pattern_v121 + v121 = \ (T_Pattern_vIn121 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX89 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Literal_vOut88 _literalIself) = inv_Literal_s89 _literalX89 (T_Literal_vIn88 ) + _self = rule291 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule292 _self + __result_ = T_Pattern_vOut121 _lhsOself + in __result_ ) + in C_Pattern_s122 v121 + {-# INLINE rule291 #-} + rule291 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_NegateFloat _rangeIself _literalIself + {-# INLINE rule292 #-} + rule292 = \ _self -> + _self + +-- Patterns ---------------------------------------------------- +-- wrapper +data Inh_Patterns = Inh_Patterns { } +data Syn_Patterns = Syn_Patterns { self_Syn_Patterns :: (Patterns) } +{-# INLINABLE wrap_Patterns #-} +wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) +wrap_Patterns (T_Patterns act) (Inh_Patterns ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Patterns_vIn124 + (T_Patterns_vOut124 _lhsOself) <- return (inv_Patterns_s125 sem arg) + return (Syn_Patterns _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Patterns #-} +sem_Patterns :: Patterns -> T_Patterns +sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) + +-- semantic domain +newtype T_Patterns = T_Patterns { + attach_T_Patterns :: Identity (T_Patterns_s125 ) + } +newtype T_Patterns_s125 = C_Patterns_s125 { + inv_Patterns_s125 :: (T_Patterns_v124 ) + } +data T_Patterns_s126 = C_Patterns_s126 +type T_Patterns_v124 = (T_Patterns_vIn124 ) -> (T_Patterns_vOut124 ) +data T_Patterns_vIn124 = T_Patterns_vIn124 +data T_Patterns_vOut124 = T_Patterns_vOut124 (Patterns) +{-# NOINLINE sem_Patterns_Cons #-} +sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns +sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Patterns_v124 + v124 = \ (T_Patterns_vIn124 ) -> ( let + _hdX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) + _tlX125 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) + (T_Pattern_vOut121 _hdIself) = inv_Pattern_s122 _hdX122 (T_Pattern_vIn121 ) + (T_Patterns_vOut124 _tlIself) = inv_Patterns_s125 _tlX125 (T_Patterns_vIn124 ) + _self = rule293 _hdIself _tlIself + _lhsOself :: Patterns + _lhsOself = rule294 _self + __result_ = T_Patterns_vOut124 _lhsOself + in __result_ ) + in C_Patterns_s125 v124 + {-# INLINE rule293 #-} + rule293 = \ ((_hdIself) :: Pattern) ((_tlIself) :: Patterns) -> + (:) _hdIself _tlIself + {-# INLINE rule294 #-} + rule294 = \ _self -> + _self +{-# NOINLINE sem_Patterns_Nil #-} +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = T_Patterns (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Patterns_v124 + v124 = \ (T_Patterns_vIn124 ) -> ( let + _self = rule295 () + _lhsOself :: Patterns + _lhsOself = rule296 _self + __result_ = T_Patterns_vOut124 _lhsOself + in __result_ ) + in C_Patterns_s125 v124 + {-# INLINE rule295 #-} + rule295 = \ (_ :: ()) -> + [] + {-# INLINE rule296 #-} + rule296 = \ _self -> + _self + +-- Position ---------------------------------------------------- +-- wrapper +data Inh_Position = Inh_Position { } +data Syn_Position = Syn_Position { self_Syn_Position :: (Position) } +{-# INLINABLE wrap_Position #-} +wrap_Position :: T_Position -> Inh_Position -> (Syn_Position ) +wrap_Position (T_Position act) (Inh_Position ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Position_vIn127 + (T_Position_vOut127 _lhsOself) <- return (inv_Position_s128 sem arg) + return (Syn_Position _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Position #-} +sem_Position :: Position -> T_Position +sem_Position ( Position_Position filename_ line_ column_ ) = sem_Position_Position filename_ line_ column_ +sem_Position ( Position_Unknown ) = sem_Position_Unknown + +-- semantic domain +newtype T_Position = T_Position { + attach_T_Position :: Identity (T_Position_s128 ) + } +newtype T_Position_s128 = C_Position_s128 { + inv_Position_s128 :: (T_Position_v127 ) + } +data T_Position_s129 = C_Position_s129 +type T_Position_v127 = (T_Position_vIn127 ) -> (T_Position_vOut127 ) +data T_Position_vIn127 = T_Position_vIn127 +data T_Position_vOut127 = T_Position_vOut127 (Position) +{-# NOINLINE sem_Position_Position #-} +sem_Position_Position :: (String) -> (Int) -> (Int) -> T_Position +sem_Position_Position arg_filename_ arg_line_ arg_column_ = T_Position (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Position_v127 + v127 = \ (T_Position_vIn127 ) -> ( let + _self = rule297 arg_column_ arg_filename_ arg_line_ + _lhsOself :: Position + _lhsOself = rule298 _self + __result_ = T_Position_vOut127 _lhsOself + in __result_ ) + in C_Position_s128 v127 + {-# INLINE rule297 #-} + rule297 = \ column_ filename_ line_ -> + Position_Position filename_ line_ column_ + {-# INLINE rule298 #-} + rule298 = \ _self -> + _self +{-# NOINLINE sem_Position_Unknown #-} +sem_Position_Unknown :: T_Position +sem_Position_Unknown = T_Position (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Position_v127 + v127 = \ (T_Position_vIn127 ) -> ( let + _self = rule299 () + _lhsOself :: Position + _lhsOself = rule300 _self + __result_ = T_Position_vOut127 _lhsOself + in __result_ ) + in C_Position_s128 v127 + {-# INLINE rule299 #-} + rule299 = \ (_ :: ()) -> + Position_Unknown + {-# INLINE rule300 #-} + rule300 = \ _self -> + _self + +-- Qualifier --------------------------------------------------- +-- wrapper +data Inh_Qualifier = Inh_Qualifier { } +data Syn_Qualifier = Syn_Qualifier { self_Syn_Qualifier :: (Qualifier) } +{-# INLINABLE wrap_Qualifier #-} +wrap_Qualifier :: T_Qualifier -> Inh_Qualifier -> (Syn_Qualifier ) +wrap_Qualifier (T_Qualifier act) (Inh_Qualifier ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifier_vIn130 + (T_Qualifier_vOut130 _lhsOself) <- return (inv_Qualifier_s131 sem arg) + return (Syn_Qualifier _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifier #-} +sem_Qualifier :: Qualifier -> T_Qualifier +sem_Qualifier ( Qualifier_Guard range_ guard_ ) = sem_Qualifier_Guard ( sem_Range range_ ) ( sem_Expression guard_ ) +sem_Qualifier ( Qualifier_Let range_ declarations_ ) = sem_Qualifier_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Qualifier ( Qualifier_Generator range_ pattern_ expression_ ) = sem_Qualifier_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Qualifier ( Qualifier_Empty range_ ) = sem_Qualifier_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Qualifier = T_Qualifier { + attach_T_Qualifier :: Identity (T_Qualifier_s131 ) + } +newtype T_Qualifier_s131 = C_Qualifier_s131 { + inv_Qualifier_s131 :: (T_Qualifier_v130 ) + } +data T_Qualifier_s132 = C_Qualifier_s132 +type T_Qualifier_v130 = (T_Qualifier_vIn130 ) -> (T_Qualifier_vOut130 ) +data T_Qualifier_vIn130 = T_Qualifier_vIn130 +data T_Qualifier_vOut130 = T_Qualifier_vOut130 (Qualifier) +{-# NOINLINE sem_Qualifier_Guard #-} +sem_Qualifier_Guard :: T_Range -> T_Expression -> T_Qualifier +sem_Qualifier_Guard arg_range_ arg_guard_ = T_Qualifier (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifier_v130 + v130 = \ (T_Qualifier_vIn130 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _guardIallVariables _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 ) + _self = rule301 _guardIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule302 _self + __result_ = T_Qualifier_vOut130 _lhsOself + in __result_ ) + in C_Qualifier_s131 v130 + {-# INLINE rule301 #-} + rule301 = \ ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + Qualifier_Guard _rangeIself _guardIself + {-# INLINE rule302 #-} + rule302 = \ _self -> + _self +{-# NOINLINE sem_Qualifier_Let #-} +sem_Qualifier_Let :: T_Range -> T_Declarations -> T_Qualifier +sem_Qualifier_Let arg_range_ arg_declarations_ = T_Qualifier (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifier_v130 + v130 = \ (T_Qualifier_vIn130 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Declarations_vOut31 _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _self = rule303 _declarationsIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule304 _self + __result_ = T_Qualifier_vOut130 _lhsOself + in __result_ ) + in C_Qualifier_s131 v130 + {-# INLINE rule303 #-} + rule303 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Qualifier_Let _rangeIself _declarationsIself + {-# INLINE rule304 #-} + rule304 = \ _self -> + _self +{-# NOINLINE sem_Qualifier_Generator #-} +sem_Qualifier_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Qualifier +sem_Qualifier_Generator arg_range_ arg_pattern_ arg_expression_ = T_Qualifier (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifier_v130 + v130 = \ (T_Qualifier_vIn130 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Pattern_vOut121 _patternIself) = inv_Pattern_s122 _patternX122 (T_Pattern_vIn121 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule305 _expressionIself _patternIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule306 _self + __result_ = T_Qualifier_vOut130 _lhsOself + in __result_ ) + in C_Qualifier_s131 v130 + {-# INLINE rule305 #-} + rule305 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Qualifier_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule306 #-} + rule306 = \ _self -> + _self +{-# NOINLINE sem_Qualifier_Empty #-} +sem_Qualifier_Empty :: T_Range -> T_Qualifier +sem_Qualifier_Empty arg_range_ = T_Qualifier (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifier_v130 + v130 = \ (T_Qualifier_vIn130 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule307 _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule308 _self + __result_ = T_Qualifier_vOut130 _lhsOself + in __result_ ) + in C_Qualifier_s131 v130 + {-# INLINE rule307 #-} + rule307 = \ ((_rangeIself) :: Range) -> + Qualifier_Empty _rangeIself + {-# INLINE rule308 #-} + rule308 = \ _self -> + _self + +-- Qualifiers -------------------------------------------------- +-- wrapper +data Inh_Qualifiers = Inh_Qualifiers { } +data Syn_Qualifiers = Syn_Qualifiers { self_Syn_Qualifiers :: (Qualifiers) } +{-# INLINABLE wrap_Qualifiers #-} +wrap_Qualifiers :: T_Qualifiers -> Inh_Qualifiers -> (Syn_Qualifiers ) +wrap_Qualifiers (T_Qualifiers act) (Inh_Qualifiers ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifiers_vIn133 + (T_Qualifiers_vOut133 _lhsOself) <- return (inv_Qualifiers_s134 sem arg) + return (Syn_Qualifiers _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifiers #-} +sem_Qualifiers :: Qualifiers -> T_Qualifiers +sem_Qualifiers list = Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list) + +-- semantic domain +newtype T_Qualifiers = T_Qualifiers { + attach_T_Qualifiers :: Identity (T_Qualifiers_s134 ) + } +newtype T_Qualifiers_s134 = C_Qualifiers_s134 { + inv_Qualifiers_s134 :: (T_Qualifiers_v133 ) + } +data T_Qualifiers_s135 = C_Qualifiers_s135 +type T_Qualifiers_v133 = (T_Qualifiers_vIn133 ) -> (T_Qualifiers_vOut133 ) +data T_Qualifiers_vIn133 = T_Qualifiers_vIn133 +data T_Qualifiers_vOut133 = T_Qualifiers_vOut133 (Qualifiers) +{-# NOINLINE sem_Qualifiers_Cons #-} +sem_Qualifiers_Cons :: T_Qualifier -> T_Qualifiers -> T_Qualifiers +sem_Qualifiers_Cons arg_hd_ arg_tl_ = T_Qualifiers (return st134) where + {-# NOINLINE st134 #-} + st134 = let + v133 :: T_Qualifiers_v133 + v133 = \ (T_Qualifiers_vIn133 ) -> ( let + _hdX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifier (arg_hd_)) + _tlX134 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_tl_)) + (T_Qualifier_vOut130 _hdIself) = inv_Qualifier_s131 _hdX131 (T_Qualifier_vIn130 ) + (T_Qualifiers_vOut133 _tlIself) = inv_Qualifiers_s134 _tlX134 (T_Qualifiers_vIn133 ) + _self = rule309 _hdIself _tlIself + _lhsOself :: Qualifiers + _lhsOself = rule310 _self + __result_ = T_Qualifiers_vOut133 _lhsOself + in __result_ ) + in C_Qualifiers_s134 v133 + {-# INLINE rule309 #-} + rule309 = \ ((_hdIself) :: Qualifier) ((_tlIself) :: Qualifiers) -> + (:) _hdIself _tlIself + {-# INLINE rule310 #-} + rule310 = \ _self -> + _self +{-# NOINLINE sem_Qualifiers_Nil #-} +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = T_Qualifiers (return st134) where + {-# NOINLINE st134 #-} + st134 = let + v133 :: T_Qualifiers_v133 + v133 = \ (T_Qualifiers_vIn133 ) -> ( let + _self = rule311 () + _lhsOself :: Qualifiers + _lhsOself = rule312 _self + __result_ = T_Qualifiers_vOut133 _lhsOself + in __result_ ) + in C_Qualifiers_s134 v133 + {-# INLINE rule311 #-} + rule311 = \ (_ :: ()) -> + [] + {-# INLINE rule312 #-} + rule312 = \ _self -> + _self + +-- Range ------------------------------------------------------- +-- wrapper +data Inh_Range = Inh_Range { } +data Syn_Range = Syn_Range { self_Syn_Range :: (Range) } +{-# INLINABLE wrap_Range #-} +wrap_Range :: T_Range -> Inh_Range -> (Syn_Range ) +wrap_Range (T_Range act) (Inh_Range ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Range_vIn136 + (T_Range_vOut136 _lhsOself) <- return (inv_Range_s137 sem arg) + return (Syn_Range _lhsOself) + ) + +-- cata +{-# INLINE sem_Range #-} +sem_Range :: Range -> T_Range +sem_Range ( Range_Range start_ stop_ ) = sem_Range_Range ( sem_Position start_ ) ( sem_Position stop_ ) + +-- semantic domain +newtype T_Range = T_Range { + attach_T_Range :: Identity (T_Range_s137 ) + } +newtype T_Range_s137 = C_Range_s137 { + inv_Range_s137 :: (T_Range_v136 ) + } +data T_Range_s138 = C_Range_s138 +type T_Range_v136 = (T_Range_vIn136 ) -> (T_Range_vOut136 ) +data T_Range_vIn136 = T_Range_vIn136 +data T_Range_vOut136 = T_Range_vOut136 (Range) +{-# NOINLINE sem_Range_Range #-} +sem_Range_Range :: T_Position -> T_Position -> T_Range +sem_Range_Range arg_start_ arg_stop_ = T_Range (return st137) where + {-# NOINLINE st137 #-} + st137 = let + v136 :: T_Range_v136 + v136 = \ (T_Range_vIn136 ) -> ( let + _startX128 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_start_)) + _stopX128 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_stop_)) + (T_Position_vOut127 _startIself) = inv_Position_s128 _startX128 (T_Position_vIn127 ) + (T_Position_vOut127 _stopIself) = inv_Position_s128 _stopX128 (T_Position_vIn127 ) + _self = rule313 _startIself _stopIself + _lhsOself :: Range + _lhsOself = rule314 _self + __result_ = T_Range_vOut136 _lhsOself + in __result_ ) + in C_Range_s137 v136 + {-# INLINE rule313 #-} + rule313 = \ ((_startIself) :: Position) ((_stopIself) :: Position) -> + Range_Range _startIself _stopIself + {-# INLINE rule314 #-} + rule314 = \ _self -> + _self + +-- RecordExpressionBinding ------------------------------------- +-- wrapper +data Inh_RecordExpressionBinding = Inh_RecordExpressionBinding { } +data Syn_RecordExpressionBinding = Syn_RecordExpressionBinding { self_Syn_RecordExpressionBinding :: (RecordExpressionBinding) } +{-# INLINABLE wrap_RecordExpressionBinding #-} +wrap_RecordExpressionBinding :: T_RecordExpressionBinding -> Inh_RecordExpressionBinding -> (Syn_RecordExpressionBinding ) +wrap_RecordExpressionBinding (T_RecordExpressionBinding act) (Inh_RecordExpressionBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBinding_vIn139 + (T_RecordExpressionBinding_vOut139 _lhsOself) <- return (inv_RecordExpressionBinding_s140 sem arg) + return (Syn_RecordExpressionBinding _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBinding #-} +sem_RecordExpressionBinding :: RecordExpressionBinding -> T_RecordExpressionBinding +sem_RecordExpressionBinding ( RecordExpressionBinding_RecordExpressionBinding range_ name_ expression_ ) = sem_RecordExpressionBinding_RecordExpressionBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_RecordExpressionBinding = T_RecordExpressionBinding { + attach_T_RecordExpressionBinding :: Identity (T_RecordExpressionBinding_s140 ) + } +newtype T_RecordExpressionBinding_s140 = C_RecordExpressionBinding_s140 { + inv_RecordExpressionBinding_s140 :: (T_RecordExpressionBinding_v139 ) + } +data T_RecordExpressionBinding_s141 = C_RecordExpressionBinding_s141 +type T_RecordExpressionBinding_v139 = (T_RecordExpressionBinding_vIn139 ) -> (T_RecordExpressionBinding_vOut139 ) +data T_RecordExpressionBinding_vIn139 = T_RecordExpressionBinding_vIn139 +data T_RecordExpressionBinding_vOut139 = T_RecordExpressionBinding_vOut139 (RecordExpressionBinding) +{-# NOINLINE sem_RecordExpressionBinding_RecordExpressionBinding #-} +sem_RecordExpressionBinding_RecordExpressionBinding :: T_Range -> T_Name -> T_Expression -> T_RecordExpressionBinding +sem_RecordExpressionBinding_RecordExpressionBinding arg_range_ arg_name_ arg_expression_ = T_RecordExpressionBinding (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBinding_v139 + v139 = \ (T_RecordExpressionBinding_vIn139 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule315 _expressionIself _nameIself _rangeIself + _lhsOself :: RecordExpressionBinding + _lhsOself = rule316 _self + __result_ = T_RecordExpressionBinding_vOut139 _lhsOself + in __result_ ) + in C_RecordExpressionBinding_s140 v139 + {-# INLINE rule315 #-} + rule315 = \ ((_expressionIself) :: Expression) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + RecordExpressionBinding_RecordExpressionBinding _rangeIself _nameIself _expressionIself + {-# INLINE rule316 #-} + rule316 = \ _self -> + _self + +-- RecordExpressionBindings ------------------------------------ +-- wrapper +data Inh_RecordExpressionBindings = Inh_RecordExpressionBindings { } +data Syn_RecordExpressionBindings = Syn_RecordExpressionBindings { self_Syn_RecordExpressionBindings :: (RecordExpressionBindings) } +{-# INLINABLE wrap_RecordExpressionBindings #-} +wrap_RecordExpressionBindings :: T_RecordExpressionBindings -> Inh_RecordExpressionBindings -> (Syn_RecordExpressionBindings ) +wrap_RecordExpressionBindings (T_RecordExpressionBindings act) (Inh_RecordExpressionBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBindings_vIn142 + (T_RecordExpressionBindings_vOut142 _lhsOself) <- return (inv_RecordExpressionBindings_s143 sem arg) + return (Syn_RecordExpressionBindings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBindings #-} +sem_RecordExpressionBindings :: RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings list = Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list) + +-- semantic domain +newtype T_RecordExpressionBindings = T_RecordExpressionBindings { + attach_T_RecordExpressionBindings :: Identity (T_RecordExpressionBindings_s143 ) + } +newtype T_RecordExpressionBindings_s143 = C_RecordExpressionBindings_s143 { + inv_RecordExpressionBindings_s143 :: (T_RecordExpressionBindings_v142 ) + } +data T_RecordExpressionBindings_s144 = C_RecordExpressionBindings_s144 +type T_RecordExpressionBindings_v142 = (T_RecordExpressionBindings_vIn142 ) -> (T_RecordExpressionBindings_vOut142 ) +data T_RecordExpressionBindings_vIn142 = T_RecordExpressionBindings_vIn142 +data T_RecordExpressionBindings_vOut142 = T_RecordExpressionBindings_vOut142 (RecordExpressionBindings) +{-# NOINLINE sem_RecordExpressionBindings_Cons #-} +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> T_RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons arg_hd_ arg_tl_ = T_RecordExpressionBindings (return st143) where + {-# NOINLINE st143 #-} + st143 = let + v142 :: T_RecordExpressionBindings_v142 + v142 = \ (T_RecordExpressionBindings_vIn142 ) -> ( let + _hdX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBinding (arg_hd_)) + _tlX143 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_tl_)) + (T_RecordExpressionBinding_vOut139 _hdIself) = inv_RecordExpressionBinding_s140 _hdX140 (T_RecordExpressionBinding_vIn139 ) + (T_RecordExpressionBindings_vOut142 _tlIself) = inv_RecordExpressionBindings_s143 _tlX143 (T_RecordExpressionBindings_vIn142 ) + _self = rule317 _hdIself _tlIself + _lhsOself :: RecordExpressionBindings + _lhsOself = rule318 _self + __result_ = T_RecordExpressionBindings_vOut142 _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s143 v142 + {-# INLINE rule317 #-} + rule317 = \ ((_hdIself) :: RecordExpressionBinding) ((_tlIself) :: RecordExpressionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule318 #-} + rule318 = \ _self -> + _self +{-# NOINLINE sem_RecordExpressionBindings_Nil #-} +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = T_RecordExpressionBindings (return st143) where + {-# NOINLINE st143 #-} + st143 = let + v142 :: T_RecordExpressionBindings_v142 + v142 = \ (T_RecordExpressionBindings_vIn142 ) -> ( let + _self = rule319 () + _lhsOself :: RecordExpressionBindings + _lhsOself = rule320 _self + __result_ = T_RecordExpressionBindings_vOut142 _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s143 v142 + {-# INLINE rule319 #-} + rule319 = \ (_ :: ()) -> + [] + {-# INLINE rule320 #-} + rule320 = \ _self -> + _self + +-- RecordPatternBinding ---------------------------------------- +-- wrapper +data Inh_RecordPatternBinding = Inh_RecordPatternBinding { } +data Syn_RecordPatternBinding = Syn_RecordPatternBinding { self_Syn_RecordPatternBinding :: (RecordPatternBinding) } +{-# INLINABLE wrap_RecordPatternBinding #-} +wrap_RecordPatternBinding :: T_RecordPatternBinding -> Inh_RecordPatternBinding -> (Syn_RecordPatternBinding ) +wrap_RecordPatternBinding (T_RecordPatternBinding act) (Inh_RecordPatternBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBinding_vIn145 + (T_RecordPatternBinding_vOut145 _lhsOself) <- return (inv_RecordPatternBinding_s146 sem arg) + return (Syn_RecordPatternBinding _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBinding #-} +sem_RecordPatternBinding :: RecordPatternBinding -> T_RecordPatternBinding +sem_RecordPatternBinding ( RecordPatternBinding_RecordPatternBinding range_ name_ pattern_ ) = sem_RecordPatternBinding_RecordPatternBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) + +-- semantic domain +newtype T_RecordPatternBinding = T_RecordPatternBinding { + attach_T_RecordPatternBinding :: Identity (T_RecordPatternBinding_s146 ) + } +newtype T_RecordPatternBinding_s146 = C_RecordPatternBinding_s146 { + inv_RecordPatternBinding_s146 :: (T_RecordPatternBinding_v145 ) + } +data T_RecordPatternBinding_s147 = C_RecordPatternBinding_s147 +type T_RecordPatternBinding_v145 = (T_RecordPatternBinding_vIn145 ) -> (T_RecordPatternBinding_vOut145 ) +data T_RecordPatternBinding_vIn145 = T_RecordPatternBinding_vIn145 +data T_RecordPatternBinding_vOut145 = T_RecordPatternBinding_vOut145 (RecordPatternBinding) +{-# NOINLINE sem_RecordPatternBinding_RecordPatternBinding #-} +sem_RecordPatternBinding_RecordPatternBinding :: T_Range -> T_Name -> T_Pattern -> T_RecordPatternBinding +sem_RecordPatternBinding_RecordPatternBinding arg_range_ arg_name_ arg_pattern_ = T_RecordPatternBinding (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBinding_v145 + v145 = \ (T_RecordPatternBinding_vIn145 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_Pattern_vOut121 _patternIself) = inv_Pattern_s122 _patternX122 (T_Pattern_vIn121 ) + _self = rule321 _nameIself _patternIself _rangeIself + _lhsOself :: RecordPatternBinding + _lhsOself = rule322 _self + __result_ = T_RecordPatternBinding_vOut145 _lhsOself + in __result_ ) + in C_RecordPatternBinding_s146 v145 + {-# INLINE rule321 #-} + rule321 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + RecordPatternBinding_RecordPatternBinding _rangeIself _nameIself _patternIself + {-# INLINE rule322 #-} + rule322 = \ _self -> + _self + +-- RecordPatternBindings --------------------------------------- +-- wrapper +data Inh_RecordPatternBindings = Inh_RecordPatternBindings { } +data Syn_RecordPatternBindings = Syn_RecordPatternBindings { self_Syn_RecordPatternBindings :: (RecordPatternBindings) } +{-# INLINABLE wrap_RecordPatternBindings #-} +wrap_RecordPatternBindings :: T_RecordPatternBindings -> Inh_RecordPatternBindings -> (Syn_RecordPatternBindings ) +wrap_RecordPatternBindings (T_RecordPatternBindings act) (Inh_RecordPatternBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBindings_vIn148 + (T_RecordPatternBindings_vOut148 _lhsOself) <- return (inv_RecordPatternBindings_s149 sem arg) + return (Syn_RecordPatternBindings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBindings #-} +sem_RecordPatternBindings :: RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings list = Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list) + +-- semantic domain +newtype T_RecordPatternBindings = T_RecordPatternBindings { + attach_T_RecordPatternBindings :: Identity (T_RecordPatternBindings_s149 ) + } +newtype T_RecordPatternBindings_s149 = C_RecordPatternBindings_s149 { + inv_RecordPatternBindings_s149 :: (T_RecordPatternBindings_v148 ) + } +data T_RecordPatternBindings_s150 = C_RecordPatternBindings_s150 +type T_RecordPatternBindings_v148 = (T_RecordPatternBindings_vIn148 ) -> (T_RecordPatternBindings_vOut148 ) +data T_RecordPatternBindings_vIn148 = T_RecordPatternBindings_vIn148 +data T_RecordPatternBindings_vOut148 = T_RecordPatternBindings_vOut148 (RecordPatternBindings) +{-# NOINLINE sem_RecordPatternBindings_Cons #-} +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> T_RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings_Cons arg_hd_ arg_tl_ = T_RecordPatternBindings (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RecordPatternBindings_v148 + v148 = \ (T_RecordPatternBindings_vIn148 ) -> ( let + _hdX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBinding (arg_hd_)) + _tlX149 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_tl_)) + (T_RecordPatternBinding_vOut145 _hdIself) = inv_RecordPatternBinding_s146 _hdX146 (T_RecordPatternBinding_vIn145 ) + (T_RecordPatternBindings_vOut148 _tlIself) = inv_RecordPatternBindings_s149 _tlX149 (T_RecordPatternBindings_vIn148 ) + _self = rule323 _hdIself _tlIself + _lhsOself :: RecordPatternBindings + _lhsOself = rule324 _self + __result_ = T_RecordPatternBindings_vOut148 _lhsOself + in __result_ ) + in C_RecordPatternBindings_s149 v148 + {-# INLINE rule323 #-} + rule323 = \ ((_hdIself) :: RecordPatternBinding) ((_tlIself) :: RecordPatternBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule324 #-} + rule324 = \ _self -> + _self +{-# NOINLINE sem_RecordPatternBindings_Nil #-} +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = T_RecordPatternBindings (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RecordPatternBindings_v148 + v148 = \ (T_RecordPatternBindings_vIn148 ) -> ( let + _self = rule325 () + _lhsOself :: RecordPatternBindings + _lhsOself = rule326 _self + __result_ = T_RecordPatternBindings_vOut148 _lhsOself + in __result_ ) + in C_RecordPatternBindings_s149 v148 + {-# INLINE rule325 #-} + rule325 = \ (_ :: ()) -> + [] + {-# INLINE rule326 #-} + rule326 = \ _self -> + _self + +-- RightHandSide ----------------------------------------------- +-- wrapper +data Inh_RightHandSide = Inh_RightHandSide { } +data Syn_RightHandSide = Syn_RightHandSide { self_Syn_RightHandSide :: (RightHandSide) } +{-# INLINABLE wrap_RightHandSide #-} +wrap_RightHandSide :: T_RightHandSide -> Inh_RightHandSide -> (Syn_RightHandSide ) +wrap_RightHandSide (T_RightHandSide act) (Inh_RightHandSide ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RightHandSide_vIn151 + (T_RightHandSide_vOut151 _lhsOself) <- return (inv_RightHandSide_s152 sem arg) + return (Syn_RightHandSide _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RightHandSide #-} +sem_RightHandSide :: RightHandSide -> T_RightHandSide +sem_RightHandSide ( RightHandSide_Expression range_ expression_ where_ ) = sem_RightHandSide_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_MaybeDeclarations where_ ) +sem_RightHandSide ( RightHandSide_Guarded range_ guardedexpressions_ where_ ) = sem_RightHandSide_Guarded ( sem_Range range_ ) ( sem_GuardedExpressions guardedexpressions_ ) ( sem_MaybeDeclarations where_ ) + +-- semantic domain +newtype T_RightHandSide = T_RightHandSide { + attach_T_RightHandSide :: Identity (T_RightHandSide_s152 ) + } +newtype T_RightHandSide_s152 = C_RightHandSide_s152 { + inv_RightHandSide_s152 :: (T_RightHandSide_v151 ) + } +data T_RightHandSide_s153 = C_RightHandSide_s153 +type T_RightHandSide_v151 = (T_RightHandSide_vIn151 ) -> (T_RightHandSide_vOut151 ) +data T_RightHandSide_vIn151 = T_RightHandSide_vIn151 +data T_RightHandSide_vOut151 = T_RightHandSide_vOut151 (RightHandSide) +{-# NOINLINE sem_RightHandSide_Expression #-} +sem_RightHandSide_Expression :: T_Range -> T_Expression -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Expression arg_range_ arg_expression_ arg_where_ = T_RightHandSide (return st152) where + {-# NOINLINE st152 #-} + st152 = let + v151 :: T_RightHandSide_v151 + v151 = \ (T_RightHandSide_vIn151 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _whereX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_MaybeDeclarations_vOut91 _whereIself) = inv_MaybeDeclarations_s92 _whereX92 (T_MaybeDeclarations_vIn91 ) + _self = rule327 _expressionIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule328 _self + __result_ = T_RightHandSide_vOut151 _lhsOself + in __result_ ) + in C_RightHandSide_s152 v151 + {-# INLINE rule327 #-} + rule327 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Expression _rangeIself _expressionIself _whereIself + {-# INLINE rule328 #-} + rule328 = \ _self -> + _self +{-# NOINLINE sem_RightHandSide_Guarded #-} +sem_RightHandSide_Guarded :: T_Range -> T_GuardedExpressions -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Guarded arg_range_ arg_guardedexpressions_ arg_where_ = T_RightHandSide (return st152) where + {-# NOINLINE st152 #-} + st152 = let + v151 :: T_RightHandSide_v151 + v151 = \ (T_RightHandSide_vIn151 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardedexpressionsX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_guardedexpressions_)) + _whereX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_GuardedExpressions_vOut64 _guardedexpressionsIself) = inv_GuardedExpressions_s65 _guardedexpressionsX65 (T_GuardedExpressions_vIn64 ) + (T_MaybeDeclarations_vOut91 _whereIself) = inv_MaybeDeclarations_s92 _whereX92 (T_MaybeDeclarations_vIn91 ) + _self = rule329 _guardedexpressionsIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule330 _self + __result_ = T_RightHandSide_vOut151 _lhsOself + in __result_ ) + in C_RightHandSide_s152 v151 + {-# INLINE rule329 #-} + rule329 = \ ((_guardedexpressionsIself) :: GuardedExpressions) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Guarded _rangeIself _guardedexpressionsIself _whereIself + {-# INLINE rule330 #-} + rule330 = \ _self -> + _self + +-- SimpleJudgement --------------------------------------------- +-- wrapper +data Inh_SimpleJudgement = Inh_SimpleJudgement { nameMap_Inh_SimpleJudgement :: ([(Name,Tp)]), simpleJudgements_Inh_SimpleJudgement :: ([(String,Tp)]) } +data Syn_SimpleJudgement = Syn_SimpleJudgement { self_Syn_SimpleJudgement :: (SimpleJudgement), simpleJudgements_Syn_SimpleJudgement :: ([(String,Tp)]), typevariables_Syn_SimpleJudgement :: (Names) } +{-# INLINABLE wrap_SimpleJudgement #-} +wrap_SimpleJudgement :: T_SimpleJudgement -> Inh_SimpleJudgement -> (Syn_SimpleJudgement ) +wrap_SimpleJudgement (T_SimpleJudgement act) (Inh_SimpleJudgement _lhsInameMap _lhsIsimpleJudgements) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_SimpleJudgement_vIn154 _lhsInameMap _lhsIsimpleJudgements + (T_SimpleJudgement_vOut154 _lhsOself _lhsOsimpleJudgements _lhsOtypevariables) <- return (inv_SimpleJudgement_s155 sem arg) + return (Syn_SimpleJudgement _lhsOself _lhsOsimpleJudgements _lhsOtypevariables) + ) + +-- cata +{-# INLINE sem_SimpleJudgement #-} +sem_SimpleJudgement :: SimpleJudgement -> T_SimpleJudgement +sem_SimpleJudgement ( SimpleJudgement_SimpleJudgement name_ type_ ) = sem_SimpleJudgement_SimpleJudgement ( sem_Name name_ ) ( sem_Type type_ ) + +-- semantic domain +newtype T_SimpleJudgement = T_SimpleJudgement { + attach_T_SimpleJudgement :: Identity (T_SimpleJudgement_s155 ) + } +newtype T_SimpleJudgement_s155 = C_SimpleJudgement_s155 { + inv_SimpleJudgement_s155 :: (T_SimpleJudgement_v154 ) + } +data T_SimpleJudgement_s156 = C_SimpleJudgement_s156 +type T_SimpleJudgement_v154 = (T_SimpleJudgement_vIn154 ) -> (T_SimpleJudgement_vOut154 ) +data T_SimpleJudgement_vIn154 = T_SimpleJudgement_vIn154 ([(Name,Tp)]) ([(String,Tp)]) +data T_SimpleJudgement_vOut154 = T_SimpleJudgement_vOut154 (SimpleJudgement) ([(String,Tp)]) (Names) +{-# NOINLINE sem_SimpleJudgement_SimpleJudgement #-} +sem_SimpleJudgement_SimpleJudgement :: T_Name -> T_Type -> T_SimpleJudgement +sem_SimpleJudgement_SimpleJudgement arg_name_ arg_type_ = T_SimpleJudgement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_SimpleJudgement_v154 + v154 = \ (T_SimpleJudgement_vIn154 _lhsInameMap _lhsIsimpleJudgements) -> ( let + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_Type_vOut172 _typeIself _typeItypevariables) = inv_Type_s173 _typeX173 (T_Type_vIn172 ) + _lhsOsimpleJudgements :: [(String,Tp)] + _lhsOsimpleJudgements = rule331 _lhsIsimpleJudgements _newJudgement + _newJudgement = rule332 _lhsInameMap _nameIself _typeIself + _lhsOtypevariables :: Names + _lhsOtypevariables = rule333 _typeItypevariables + _self = rule334 _nameIself _typeIself + _lhsOself :: SimpleJudgement + _lhsOself = rule335 _self + __result_ = T_SimpleJudgement_vOut154 _lhsOself _lhsOsimpleJudgements _lhsOtypevariables + in __result_ ) + in C_SimpleJudgement_s155 v154 + {-# INLINE rule331 #-} + rule331 = \ ((_lhsIsimpleJudgements) :: [(String,Tp)]) _newJudgement -> + _newJudgement : _lhsIsimpleJudgements + {-# INLINE rule332 #-} + rule332 = \ ((_lhsInameMap) :: [(Name,Tp)]) ((_nameIself) :: Name) ((_typeIself) :: Type) -> + (show _nameIself, makeTpFromType _lhsInameMap _typeIself) + {-# INLINE rule333 #-} + rule333 = \ ((_typeItypevariables) :: Names) -> + _typeItypevariables + {-# INLINE rule334 #-} + rule334 = \ ((_nameIself) :: Name) ((_typeIself) :: Type) -> + SimpleJudgement_SimpleJudgement _nameIself _typeIself + {-# INLINE rule335 #-} + rule335 = \ _self -> + _self + +-- SimpleJudgements -------------------------------------------- +-- wrapper +data Inh_SimpleJudgements = Inh_SimpleJudgements { nameMap_Inh_SimpleJudgements :: ([(Name,Tp)]), simpleJudgements_Inh_SimpleJudgements :: ([(String,Tp)]) } +data Syn_SimpleJudgements = Syn_SimpleJudgements { self_Syn_SimpleJudgements :: (SimpleJudgements), simpleJudgements_Syn_SimpleJudgements :: ([(String,Tp)]), typevariables_Syn_SimpleJudgements :: (Names) } +{-# INLINABLE wrap_SimpleJudgements #-} +wrap_SimpleJudgements :: T_SimpleJudgements -> Inh_SimpleJudgements -> (Syn_SimpleJudgements ) +wrap_SimpleJudgements (T_SimpleJudgements act) (Inh_SimpleJudgements _lhsInameMap _lhsIsimpleJudgements) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_SimpleJudgements_vIn157 _lhsInameMap _lhsIsimpleJudgements + (T_SimpleJudgements_vOut157 _lhsOself _lhsOsimpleJudgements _lhsOtypevariables) <- return (inv_SimpleJudgements_s158 sem arg) + return (Syn_SimpleJudgements _lhsOself _lhsOsimpleJudgements _lhsOtypevariables) + ) + +-- cata +{-# NOINLINE sem_SimpleJudgements #-} +sem_SimpleJudgements :: SimpleJudgements -> T_SimpleJudgements +sem_SimpleJudgements list = Prelude.foldr sem_SimpleJudgements_Cons sem_SimpleJudgements_Nil (Prelude.map sem_SimpleJudgement list) + +-- semantic domain +newtype T_SimpleJudgements = T_SimpleJudgements { + attach_T_SimpleJudgements :: Identity (T_SimpleJudgements_s158 ) + } +newtype T_SimpleJudgements_s158 = C_SimpleJudgements_s158 { + inv_SimpleJudgements_s158 :: (T_SimpleJudgements_v157 ) + } +data T_SimpleJudgements_s159 = C_SimpleJudgements_s159 +type T_SimpleJudgements_v157 = (T_SimpleJudgements_vIn157 ) -> (T_SimpleJudgements_vOut157 ) +data T_SimpleJudgements_vIn157 = T_SimpleJudgements_vIn157 ([(Name,Tp)]) ([(String,Tp)]) +data T_SimpleJudgements_vOut157 = T_SimpleJudgements_vOut157 (SimpleJudgements) ([(String,Tp)]) (Names) +{-# NOINLINE sem_SimpleJudgements_Cons #-} +sem_SimpleJudgements_Cons :: T_SimpleJudgement -> T_SimpleJudgements -> T_SimpleJudgements +sem_SimpleJudgements_Cons arg_hd_ arg_tl_ = T_SimpleJudgements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_SimpleJudgements_v157 + v157 = \ (T_SimpleJudgements_vIn157 _lhsInameMap _lhsIsimpleJudgements) -> ( let + _hdX155 = Control.Monad.Identity.runIdentity (attach_T_SimpleJudgement (arg_hd_)) + _tlX158 = Control.Monad.Identity.runIdentity (attach_T_SimpleJudgements (arg_tl_)) + (T_SimpleJudgement_vOut154 _hdIself _hdIsimpleJudgements _hdItypevariables) = inv_SimpleJudgement_s155 _hdX155 (T_SimpleJudgement_vIn154 _hdOnameMap _hdOsimpleJudgements) + (T_SimpleJudgements_vOut157 _tlIself _tlIsimpleJudgements _tlItypevariables) = inv_SimpleJudgements_s158 _tlX158 (T_SimpleJudgements_vIn157 _tlOnameMap _tlOsimpleJudgements) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule336 _hdItypevariables _tlItypevariables + _self = rule337 _hdIself _tlIself + _lhsOself :: SimpleJudgements + _lhsOself = rule338 _self + _lhsOsimpleJudgements :: [(String,Tp)] + _lhsOsimpleJudgements = rule339 _tlIsimpleJudgements + _hdOnameMap = rule340 _lhsInameMap + _hdOsimpleJudgements = rule341 _lhsIsimpleJudgements + _tlOnameMap = rule342 _lhsInameMap + _tlOsimpleJudgements = rule343 _hdIsimpleJudgements + __result_ = T_SimpleJudgements_vOut157 _lhsOself _lhsOsimpleJudgements _lhsOtypevariables + in __result_ ) + in C_SimpleJudgements_s158 v157 + {-# INLINE rule336 #-} + rule336 = \ ((_hdItypevariables) :: Names) ((_tlItypevariables) :: Names) -> + _hdItypevariables ++ _tlItypevariables + {-# INLINE rule337 #-} + rule337 = \ ((_hdIself) :: SimpleJudgement) ((_tlIself) :: SimpleJudgements) -> + (:) _hdIself _tlIself + {-# INLINE rule338 #-} + rule338 = \ _self -> + _self + {-# INLINE rule339 #-} + rule339 = \ ((_tlIsimpleJudgements) :: [(String,Tp)]) -> + _tlIsimpleJudgements + {-# INLINE rule340 #-} + rule340 = \ ((_lhsInameMap) :: [(Name,Tp)]) -> + _lhsInameMap + {-# INLINE rule341 #-} + rule341 = \ ((_lhsIsimpleJudgements) :: [(String,Tp)]) -> + _lhsIsimpleJudgements + {-# INLINE rule342 #-} + rule342 = \ ((_lhsInameMap) :: [(Name,Tp)]) -> + _lhsInameMap + {-# INLINE rule343 #-} + rule343 = \ ((_hdIsimpleJudgements) :: [(String,Tp)]) -> + _hdIsimpleJudgements +{-# NOINLINE sem_SimpleJudgements_Nil #-} +sem_SimpleJudgements_Nil :: T_SimpleJudgements +sem_SimpleJudgements_Nil = T_SimpleJudgements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_SimpleJudgements_v157 + v157 = \ (T_SimpleJudgements_vIn157 _lhsInameMap _lhsIsimpleJudgements) -> ( let + _lhsOtypevariables :: Names + _lhsOtypevariables = rule344 () + _self = rule345 () + _lhsOself :: SimpleJudgements + _lhsOself = rule346 _self + _lhsOsimpleJudgements :: [(String,Tp)] + _lhsOsimpleJudgements = rule347 _lhsIsimpleJudgements + __result_ = T_SimpleJudgements_vOut157 _lhsOself _lhsOsimpleJudgements _lhsOtypevariables + in __result_ ) + in C_SimpleJudgements_s158 v157 + {-# INLINE rule344 #-} + rule344 = \ (_ :: ()) -> + [] + {-# INLINE rule345 #-} + rule345 = \ (_ :: ()) -> + [] + {-# INLINE rule346 #-} + rule346 = \ _self -> + _self + {-# INLINE rule347 #-} + rule347 = \ ((_lhsIsimpleJudgements) :: [(String,Tp)]) -> + _lhsIsimpleJudgements + +-- SimpleType -------------------------------------------------- +-- wrapper +data Inh_SimpleType = Inh_SimpleType { } +data Syn_SimpleType = Syn_SimpleType { self_Syn_SimpleType :: (SimpleType) } +{-# INLINABLE wrap_SimpleType #-} +wrap_SimpleType :: T_SimpleType -> Inh_SimpleType -> (Syn_SimpleType ) +wrap_SimpleType (T_SimpleType act) (Inh_SimpleType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_SimpleType_vIn160 + (T_SimpleType_vOut160 _lhsOself) <- return (inv_SimpleType_s161 sem arg) + return (Syn_SimpleType _lhsOself) + ) + +-- cata +{-# INLINE sem_SimpleType #-} +sem_SimpleType :: SimpleType -> T_SimpleType +sem_SimpleType ( SimpleType_SimpleType range_ name_ typevariables_ ) = sem_SimpleType_SimpleType ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Names typevariables_ ) + +-- semantic domain +newtype T_SimpleType = T_SimpleType { + attach_T_SimpleType :: Identity (T_SimpleType_s161 ) + } +newtype T_SimpleType_s161 = C_SimpleType_s161 { + inv_SimpleType_s161 :: (T_SimpleType_v160 ) + } +data T_SimpleType_s162 = C_SimpleType_s162 +type T_SimpleType_v160 = (T_SimpleType_vIn160 ) -> (T_SimpleType_vOut160 ) +data T_SimpleType_vIn160 = T_SimpleType_vIn160 +data T_SimpleType_vOut160 = T_SimpleType_vOut160 (SimpleType) +{-# NOINLINE sem_SimpleType_SimpleType #-} +sem_SimpleType_SimpleType :: T_Range -> T_Name -> T_Names -> T_SimpleType +sem_SimpleType_SimpleType arg_range_ arg_name_ arg_typevariables_ = T_SimpleType (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_SimpleType_v160 + v160 = \ (T_SimpleType_vIn160 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typevariablesX119 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + (T_Names_vOut118 _typevariablesIself) = inv_Names_s119 _typevariablesX119 (T_Names_vIn118 ) + _self = rule348 _nameIself _rangeIself _typevariablesIself + _lhsOself :: SimpleType + _lhsOself = rule349 _self + __result_ = T_SimpleType_vOut160 _lhsOself + in __result_ ) + in C_SimpleType_s161 v160 + {-# INLINE rule348 #-} + rule348 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typevariablesIself) :: Names) -> + SimpleType_SimpleType _rangeIself _nameIself _typevariablesIself + {-# INLINE rule349 #-} + rule349 = \ _self -> + _self + +-- Statement --------------------------------------------------- +-- wrapper +data Inh_Statement = Inh_Statement { } +data Syn_Statement = Syn_Statement { self_Syn_Statement :: (Statement) } +{-# INLINABLE wrap_Statement #-} +wrap_Statement :: T_Statement -> Inh_Statement -> (Syn_Statement ) +wrap_Statement (T_Statement act) (Inh_Statement ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statement_vIn163 + (T_Statement_vOut163 _lhsOself) <- return (inv_Statement_s164 sem arg) + return (Syn_Statement _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statement #-} +sem_Statement :: Statement -> T_Statement +sem_Statement ( Statement_Expression range_ expression_ ) = sem_Statement_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Let range_ declarations_ ) = sem_Statement_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Statement ( Statement_Generator range_ pattern_ expression_ ) = sem_Statement_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Empty range_ ) = sem_Statement_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Statement = T_Statement { + attach_T_Statement :: Identity (T_Statement_s164 ) + } +newtype T_Statement_s164 = C_Statement_s164 { + inv_Statement_s164 :: (T_Statement_v163 ) + } +data T_Statement_s165 = C_Statement_s165 +type T_Statement_v163 = (T_Statement_vIn163 ) -> (T_Statement_vOut163 ) +data T_Statement_vIn163 = T_Statement_vIn163 +data T_Statement_vOut163 = T_Statement_vOut163 (Statement) +{-# NOINLINE sem_Statement_Expression #-} +sem_Statement_Expression :: T_Range -> T_Expression -> T_Statement +sem_Statement_Expression arg_range_ arg_expression_ = T_Statement (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Statement_v163 + v163 = \ (T_Statement_vIn163 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule350 _expressionIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule351 _self + __result_ = T_Statement_vOut163 _lhsOself + in __result_ ) + in C_Statement_s164 v163 + {-# INLINE rule350 #-} + rule350 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Statement_Expression _rangeIself _expressionIself + {-# INLINE rule351 #-} + rule351 = \ _self -> + _self +{-# NOINLINE sem_Statement_Let #-} +sem_Statement_Let :: T_Range -> T_Declarations -> T_Statement +sem_Statement_Let arg_range_ arg_declarations_ = T_Statement (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Statement_v163 + v163 = \ (T_Statement_vIn163 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Declarations_vOut31 _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _self = rule352 _declarationsIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule353 _self + __result_ = T_Statement_vOut163 _lhsOself + in __result_ ) + in C_Statement_s164 v163 + {-# INLINE rule352 #-} + rule352 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Statement_Let _rangeIself _declarationsIself + {-# INLINE rule353 #-} + rule353 = \ _self -> + _self +{-# NOINLINE sem_Statement_Generator #-} +sem_Statement_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Statement +sem_Statement_Generator arg_range_ arg_pattern_ arg_expression_ = T_Statement (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Statement_v163 + v163 = \ (T_Statement_vIn163 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX122 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Pattern_vOut121 _patternIself) = inv_Pattern_s122 _patternX122 (T_Pattern_vIn121 ) + (T_Expression_vOut40 _expressionIallVariables _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule354 _expressionIself _patternIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule355 _self + __result_ = T_Statement_vOut163 _lhsOself + in __result_ ) + in C_Statement_s164 v163 + {-# INLINE rule354 #-} + rule354 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Statement_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule355 #-} + rule355 = \ _self -> + _self +{-# NOINLINE sem_Statement_Empty #-} +sem_Statement_Empty :: T_Range -> T_Statement +sem_Statement_Empty arg_range_ = T_Statement (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Statement_v163 + v163 = \ (T_Statement_vIn163 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + _self = rule356 _rangeIself + _lhsOself :: Statement + _lhsOself = rule357 _self + __result_ = T_Statement_vOut163 _lhsOself + in __result_ ) + in C_Statement_s164 v163 + {-# INLINE rule356 #-} + rule356 = \ ((_rangeIself) :: Range) -> + Statement_Empty _rangeIself + {-# INLINE rule357 #-} + rule357 = \ _self -> + _self + +-- Statements -------------------------------------------------- +-- wrapper +data Inh_Statements = Inh_Statements { } +data Syn_Statements = Syn_Statements { self_Syn_Statements :: (Statements) } +{-# INLINABLE wrap_Statements #-} +wrap_Statements :: T_Statements -> Inh_Statements -> (Syn_Statements ) +wrap_Statements (T_Statements act) (Inh_Statements ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statements_vIn166 + (T_Statements_vOut166 _lhsOself) <- return (inv_Statements_s167 sem arg) + return (Syn_Statements _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statements #-} +sem_Statements :: Statements -> T_Statements +sem_Statements list = Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list) + +-- semantic domain +newtype T_Statements = T_Statements { + attach_T_Statements :: Identity (T_Statements_s167 ) + } +newtype T_Statements_s167 = C_Statements_s167 { + inv_Statements_s167 :: (T_Statements_v166 ) + } +data T_Statements_s168 = C_Statements_s168 +type T_Statements_v166 = (T_Statements_vIn166 ) -> (T_Statements_vOut166 ) +data T_Statements_vIn166 = T_Statements_vIn166 +data T_Statements_vOut166 = T_Statements_vOut166 (Statements) +{-# NOINLINE sem_Statements_Cons #-} +sem_Statements_Cons :: T_Statement -> T_Statements -> T_Statements +sem_Statements_Cons arg_hd_ arg_tl_ = T_Statements (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Statements_v166 + v166 = \ (T_Statements_vIn166 ) -> ( let + _hdX164 = Control.Monad.Identity.runIdentity (attach_T_Statement (arg_hd_)) + _tlX167 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_tl_)) + (T_Statement_vOut163 _hdIself) = inv_Statement_s164 _hdX164 (T_Statement_vIn163 ) + (T_Statements_vOut166 _tlIself) = inv_Statements_s167 _tlX167 (T_Statements_vIn166 ) + _self = rule358 _hdIself _tlIself + _lhsOself :: Statements + _lhsOself = rule359 _self + __result_ = T_Statements_vOut166 _lhsOself + in __result_ ) + in C_Statements_s167 v166 + {-# INLINE rule358 #-} + rule358 = \ ((_hdIself) :: Statement) ((_tlIself) :: Statements) -> + (:) _hdIself _tlIself + {-# INLINE rule359 #-} + rule359 = \ _self -> + _self +{-# NOINLINE sem_Statements_Nil #-} +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = T_Statements (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Statements_v166 + v166 = \ (T_Statements_vIn166 ) -> ( let + _self = rule360 () + _lhsOself :: Statements + _lhsOself = rule361 _self + __result_ = T_Statements_vOut166 _lhsOself + in __result_ ) + in C_Statements_s167 v166 + {-# INLINE rule360 #-} + rule360 = \ (_ :: ()) -> + [] + {-# INLINE rule361 #-} + rule361 = \ _self -> + _self + +-- Strings ----------------------------------------------------- +-- wrapper +data Inh_Strings = Inh_Strings { } +data Syn_Strings = Syn_Strings { self_Syn_Strings :: (Strings) } +{-# INLINABLE wrap_Strings #-} +wrap_Strings :: T_Strings -> Inh_Strings -> (Syn_Strings ) +wrap_Strings (T_Strings act) (Inh_Strings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Strings_vIn169 + (T_Strings_vOut169 _lhsOself) <- return (inv_Strings_s170 sem arg) + return (Syn_Strings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Strings #-} +sem_Strings :: Strings -> T_Strings +sem_Strings list = Prelude.foldr sem_Strings_Cons sem_Strings_Nil list + +-- semantic domain +newtype T_Strings = T_Strings { + attach_T_Strings :: Identity (T_Strings_s170 ) + } +newtype T_Strings_s170 = C_Strings_s170 { + inv_Strings_s170 :: (T_Strings_v169 ) + } +data T_Strings_s171 = C_Strings_s171 +type T_Strings_v169 = (T_Strings_vIn169 ) -> (T_Strings_vOut169 ) +data T_Strings_vIn169 = T_Strings_vIn169 +data T_Strings_vOut169 = T_Strings_vOut169 (Strings) +{-# NOINLINE sem_Strings_Cons #-} +sem_Strings_Cons :: (String) -> T_Strings -> T_Strings +sem_Strings_Cons arg_hd_ arg_tl_ = T_Strings (return st170) where + {-# NOINLINE st170 #-} + st170 = let + v169 :: T_Strings_v169 + v169 = \ (T_Strings_vIn169 ) -> ( let + _tlX170 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_tl_)) + (T_Strings_vOut169 _tlIself) = inv_Strings_s170 _tlX170 (T_Strings_vIn169 ) + _self = rule362 _tlIself arg_hd_ + _lhsOself :: Strings + _lhsOself = rule363 _self + __result_ = T_Strings_vOut169 _lhsOself + in __result_ ) + in C_Strings_s170 v169 + {-# INLINE rule362 #-} + rule362 = \ ((_tlIself) :: Strings) hd_ -> + (:) hd_ _tlIself + {-# INLINE rule363 #-} + rule363 = \ _self -> + _self +{-# NOINLINE sem_Strings_Nil #-} +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = T_Strings (return st170) where + {-# NOINLINE st170 #-} + st170 = let + v169 :: T_Strings_v169 + v169 = \ (T_Strings_vIn169 ) -> ( let + _self = rule364 () + _lhsOself :: Strings + _lhsOself = rule365 _self + __result_ = T_Strings_vOut169 _lhsOself + in __result_ ) + in C_Strings_s170 v169 + {-# INLINE rule364 #-} + rule364 = \ (_ :: ()) -> + [] + {-# INLINE rule365 #-} + rule365 = \ _self -> + _self + +-- Type -------------------------------------------------------- +-- wrapper +data Inh_Type = Inh_Type { } +data Syn_Type = Syn_Type { self_Syn_Type :: (Type), typevariables_Syn_Type :: (Names) } +{-# INLINABLE wrap_Type #-} +wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) +wrap_Type (T_Type act) (Inh_Type ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Type_vIn172 + (T_Type_vOut172 _lhsOself _lhsOtypevariables) <- return (inv_Type_s173 sem arg) + return (Syn_Type _lhsOself _lhsOtypevariables) + ) + +-- cata +{-# NOINLINE sem_Type #-} +sem_Type :: Type -> T_Type +sem_Type ( Type_Application range_ prefix_ function_ arguments_ ) = sem_Type_Application ( sem_Range range_ ) prefix_ ( sem_Type function_ ) ( sem_Types arguments_ ) +sem_Type ( Type_Variable range_ name_ ) = sem_Type_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Constructor range_ name_ ) = sem_Type_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Qualified range_ context_ type_ ) = sem_Type_Qualified ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Type type_ ) +sem_Type ( Type_Forall range_ typevariables_ type_ ) = sem_Type_Forall ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Exists range_ typevariables_ type_ ) = sem_Type_Exists ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Parenthesized range_ type_ ) = sem_Type_Parenthesized ( sem_Range range_ ) ( sem_Type type_ ) + +-- semantic domain +newtype T_Type = T_Type { + attach_T_Type :: Identity (T_Type_s173 ) + } +newtype T_Type_s173 = C_Type_s173 { + inv_Type_s173 :: (T_Type_v172 ) + } +data T_Type_s174 = C_Type_s174 +type T_Type_v172 = (T_Type_vIn172 ) -> (T_Type_vOut172 ) +data T_Type_vIn172 = T_Type_vIn172 +data T_Type_vOut172 = T_Type_vOut172 (Type) (Names) +{-# NOINLINE sem_Type_Application #-} +sem_Type_Application :: T_Range -> (Bool) -> T_Type -> T_Types -> T_Type +sem_Type_Application arg_range_ arg_prefix_ arg_function_ arg_arguments_ = T_Type (return st173) where + {-# NOINLINE st173 #-} + st173 = let + v172 :: T_Type_v172 + v172 = \ (T_Type_vIn172 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_function_)) + _argumentsX179 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_arguments_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Type_vOut172 _functionIself _functionItypevariables) = inv_Type_s173 _functionX173 (T_Type_vIn172 ) + (T_Types_vOut178 _argumentsIself _argumentsItypevariables) = inv_Types_s179 _argumentsX179 (T_Types_vIn178 ) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule366 _argumentsItypevariables _functionItypevariables + _self = rule367 _argumentsIself _functionIself _rangeIself arg_prefix_ + _lhsOself :: Type + _lhsOself = rule368 _self + __result_ = T_Type_vOut172 _lhsOself _lhsOtypevariables + in __result_ ) + in C_Type_s173 v172 + {-# INLINE rule366 #-} + rule366 = \ ((_argumentsItypevariables) :: Names) ((_functionItypevariables) :: Names) -> + _functionItypevariables ++ _argumentsItypevariables + {-# INLINE rule367 #-} + rule367 = \ ((_argumentsIself) :: Types) ((_functionIself) :: Type) ((_rangeIself) :: Range) prefix_ -> + Type_Application _rangeIself prefix_ _functionIself _argumentsIself + {-# INLINE rule368 #-} + rule368 = \ _self -> + _self +{-# NOINLINE sem_Type_Variable #-} +sem_Type_Variable :: T_Range -> T_Name -> T_Type +sem_Type_Variable arg_range_ arg_name_ = T_Type (return st173) where + {-# NOINLINE st173 #-} + st173 = let + v172 :: T_Type_v172 + v172 = \ (T_Type_vIn172 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule369 _nameIself + _self = rule370 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule371 _self + __result_ = T_Type_vOut172 _lhsOself _lhsOtypevariables + in __result_ ) + in C_Type_s173 v172 + {-# INLINE rule369 #-} + rule369 = \ ((_nameIself) :: Name) -> + [ _nameIself ] + {-# INLINE rule370 #-} + rule370 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Variable _rangeIself _nameIself + {-# INLINE rule371 #-} + rule371 = \ _self -> + _self +{-# NOINLINE sem_Type_Constructor #-} +sem_Type_Constructor :: T_Range -> T_Name -> T_Type +sem_Type_Constructor arg_range_ arg_name_ = T_Type (return st173) where + {-# NOINLINE st173 #-} + st173 = let + v172 :: T_Type_v172 + v172 = \ (T_Type_vIn172 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule372 () + _self = rule373 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule374 _self + __result_ = T_Type_vOut172 _lhsOself _lhsOtypevariables + in __result_ ) + in C_Type_s173 v172 + {-# INLINE rule372 #-} + rule372 = \ (_ :: ()) -> + [] + {-# INLINE rule373 #-} + rule373 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Constructor _rangeIself _nameIself + {-# INLINE rule374 #-} + rule374 = \ _self -> + _self +{-# NOINLINE sem_Type_Qualified #-} +sem_Type_Qualified :: T_Range -> T_ContextItems -> T_Type -> T_Type +sem_Type_Qualified arg_range_ arg_context_ arg_type_ = T_Type (return st173) where + {-# NOINLINE st173 #-} + st173 = let + v172 :: T_Type_v172 + v172 = \ (T_Type_vIn172 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _typeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Type_vOut172 _typeIself _typeItypevariables) = inv_Type_s173 _typeX173 (T_Type_vIn172 ) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule375 _typeItypevariables + _self = rule376 _contextIself _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule377 _self + __result_ = T_Type_vOut172 _lhsOself _lhsOtypevariables + in __result_ ) + in C_Type_s173 v172 + {-# INLINE rule375 #-} + rule375 = \ ((_typeItypevariables) :: Names) -> + _typeItypevariables + {-# INLINE rule376 #-} + rule376 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Qualified _rangeIself _contextIself _typeIself + {-# INLINE rule377 #-} + rule377 = \ _self -> + _self +{-# NOINLINE sem_Type_Forall #-} +sem_Type_Forall :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Forall arg_range_ arg_typevariables_ arg_type_ = T_Type (return st173) where + {-# NOINLINE st173 #-} + st173 = let + v172 :: T_Type_v172 + v172 = \ (T_Type_vIn172 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX119 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Names_vOut118 _typevariablesIself) = inv_Names_s119 _typevariablesX119 (T_Names_vIn118 ) + (T_Type_vOut172 _typeIself _typeItypevariables) = inv_Type_s173 _typeX173 (T_Type_vIn172 ) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule378 _typeItypevariables + _self = rule379 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule380 _self + __result_ = T_Type_vOut172 _lhsOself _lhsOtypevariables + in __result_ ) + in C_Type_s173 v172 + {-# INLINE rule378 #-} + rule378 = \ ((_typeItypevariables) :: Names) -> + _typeItypevariables + {-# INLINE rule379 #-} + rule379 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Forall _rangeIself _typevariablesIself _typeIself + {-# INLINE rule380 #-} + rule380 = \ _self -> + _self +{-# NOINLINE sem_Type_Exists #-} +sem_Type_Exists :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Exists arg_range_ arg_typevariables_ arg_type_ = T_Type (return st173) where + {-# NOINLINE st173 #-} + st173 = let + v172 :: T_Type_v172 + v172 = \ (T_Type_vIn172 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX119 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Names_vOut118 _typevariablesIself) = inv_Names_s119 _typevariablesX119 (T_Names_vIn118 ) + (T_Type_vOut172 _typeIself _typeItypevariables) = inv_Type_s173 _typeX173 (T_Type_vIn172 ) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule381 _typeItypevariables + _self = rule382 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule383 _self + __result_ = T_Type_vOut172 _lhsOself _lhsOtypevariables + in __result_ ) + in C_Type_s173 v172 + {-# INLINE rule381 #-} + rule381 = \ ((_typeItypevariables) :: Names) -> + _typeItypevariables + {-# INLINE rule382 #-} + rule382 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Exists _rangeIself _typevariablesIself _typeIself + {-# INLINE rule383 #-} + rule383 = \ _self -> + _self +{-# NOINLINE sem_Type_Parenthesized #-} +sem_Type_Parenthesized :: T_Range -> T_Type -> T_Type +sem_Type_Parenthesized arg_range_ arg_type_ = T_Type (return st173) where + {-# NOINLINE st173 #-} + st173 = let + v172 :: T_Type_v172 + v172 = \ (T_Type_vIn172 ) -> ( let + _rangeX137 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut136 _rangeIself) = inv_Range_s137 _rangeX137 (T_Range_vIn136 ) + (T_Type_vOut172 _typeIself _typeItypevariables) = inv_Type_s173 _typeX173 (T_Type_vIn172 ) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule384 _typeItypevariables + _self = rule385 _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule386 _self + __result_ = T_Type_vOut172 _lhsOself _lhsOtypevariables + in __result_ ) + in C_Type_s173 v172 + {-# INLINE rule384 #-} + rule384 = \ ((_typeItypevariables) :: Names) -> + _typeItypevariables + {-# INLINE rule385 #-} + rule385 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Parenthesized _rangeIself _typeIself + {-# INLINE rule386 #-} + rule386 = \ _self -> + _self + +-- TypeRule ---------------------------------------------------- +-- wrapper +data Inh_TypeRule = Inh_TypeRule { nameMap_Inh_TypeRule :: ([(Name,Tp)]), simpleJudgements_Inh_TypeRule :: ([(String,Tp)]) } +data Syn_TypeRule = Syn_TypeRule { conclusionAllVariables_Syn_TypeRule :: ([(Name,Entity)]), conclusionExpression_Syn_TypeRule :: (Expression), conclusionType_Syn_TypeRule :: (Tp), self_Syn_TypeRule :: (TypeRule), simpleJudgements_Syn_TypeRule :: ([(String,Tp)]), typevariables_Syn_TypeRule :: (Names) } +{-# INLINABLE wrap_TypeRule #-} +wrap_TypeRule :: T_TypeRule -> Inh_TypeRule -> (Syn_TypeRule ) +wrap_TypeRule (T_TypeRule act) (Inh_TypeRule _lhsInameMap _lhsIsimpleJudgements) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_TypeRule_vIn175 _lhsInameMap _lhsIsimpleJudgements + (T_TypeRule_vOut175 _lhsOconclusionAllVariables _lhsOconclusionExpression _lhsOconclusionType _lhsOself _lhsOsimpleJudgements _lhsOtypevariables) <- return (inv_TypeRule_s176 sem arg) + return (Syn_TypeRule _lhsOconclusionAllVariables _lhsOconclusionExpression _lhsOconclusionType _lhsOself _lhsOsimpleJudgements _lhsOtypevariables) + ) + +-- cata +{-# INLINE sem_TypeRule #-} +sem_TypeRule :: TypeRule -> T_TypeRule +sem_TypeRule ( TypeRule_TypeRule premises_ conclusion_ ) = sem_TypeRule_TypeRule ( sem_SimpleJudgements premises_ ) ( sem_Judgement conclusion_ ) + +-- semantic domain +newtype T_TypeRule = T_TypeRule { + attach_T_TypeRule :: Identity (T_TypeRule_s176 ) + } +newtype T_TypeRule_s176 = C_TypeRule_s176 { + inv_TypeRule_s176 :: (T_TypeRule_v175 ) + } +data T_TypeRule_s177 = C_TypeRule_s177 +type T_TypeRule_v175 = (T_TypeRule_vIn175 ) -> (T_TypeRule_vOut175 ) +data T_TypeRule_vIn175 = T_TypeRule_vIn175 ([(Name,Tp)]) ([(String,Tp)]) +data T_TypeRule_vOut175 = T_TypeRule_vOut175 ([(Name,Entity)]) (Expression) (Tp) (TypeRule) ([(String,Tp)]) (Names) +{-# NOINLINE sem_TypeRule_TypeRule #-} +sem_TypeRule_TypeRule :: T_SimpleJudgements -> T_Judgement -> T_TypeRule +sem_TypeRule_TypeRule arg_premises_ arg_conclusion_ = T_TypeRule (return st176) where + {-# NOINLINE st176 #-} + st176 = let + v175 :: T_TypeRule_v175 + v175 = \ (T_TypeRule_vIn175 _lhsInameMap _lhsIsimpleJudgements) -> ( let + _premisesX158 = Control.Monad.Identity.runIdentity (attach_T_SimpleJudgements (arg_premises_)) + _conclusionX83 = Control.Monad.Identity.runIdentity (attach_T_Judgement (arg_conclusion_)) + (T_SimpleJudgements_vOut157 _premisesIself _premisesIsimpleJudgements _premisesItypevariables) = inv_SimpleJudgements_s158 _premisesX158 (T_SimpleJudgements_vIn157 _premisesOnameMap _premisesOsimpleJudgements) + (T_Judgement_vOut82 _conclusionIallVariables _conclusionIconclusionType _conclusionIself _conclusionItheExpression _conclusionItypevariables) = inv_Judgement_s83 _conclusionX83 (T_Judgement_vIn82 _conclusionOnameMap) + _lhsOconclusionAllVariables :: [(Name,Entity)] + _lhsOconclusionAllVariables = rule387 _conclusionIallVariables + _lhsOconclusionExpression :: Expression + _lhsOconclusionExpression = rule388 _conclusionItheExpression + _lhsOtypevariables :: Names + _lhsOtypevariables = rule389 _conclusionItypevariables _premisesItypevariables + _self = rule390 _conclusionIself _premisesIself + _lhsOself :: TypeRule + _lhsOself = rule391 _self + _lhsOconclusionType :: Tp + _lhsOconclusionType = rule392 _conclusionIconclusionType + _lhsOsimpleJudgements :: [(String,Tp)] + _lhsOsimpleJudgements = rule393 _premisesIsimpleJudgements + _premisesOnameMap = rule394 _lhsInameMap + _premisesOsimpleJudgements = rule395 _lhsIsimpleJudgements + _conclusionOnameMap = rule396 _lhsInameMap + __result_ = T_TypeRule_vOut175 _lhsOconclusionAllVariables _lhsOconclusionExpression _lhsOconclusionType _lhsOself _lhsOsimpleJudgements _lhsOtypevariables + in __result_ ) + in C_TypeRule_s176 v175 + {-# INLINE rule387 #-} + rule387 = \ ((_conclusionIallVariables) :: [(Name,Entity)]) -> + _conclusionIallVariables + {-# INLINE rule388 #-} + rule388 = \ ((_conclusionItheExpression) :: Expression) -> + _conclusionItheExpression + {-# INLINE rule389 #-} + rule389 = \ ((_conclusionItypevariables) :: Names) ((_premisesItypevariables) :: Names) -> + _premisesItypevariables ++ _conclusionItypevariables + {-# INLINE rule390 #-} + rule390 = \ ((_conclusionIself) :: Judgement) ((_premisesIself) :: SimpleJudgements) -> + TypeRule_TypeRule _premisesIself _conclusionIself + {-# INLINE rule391 #-} + rule391 = \ _self -> + _self + {-# INLINE rule392 #-} + rule392 = \ ((_conclusionIconclusionType) :: Tp) -> + _conclusionIconclusionType + {-# INLINE rule393 #-} + rule393 = \ ((_premisesIsimpleJudgements) :: [(String,Tp)]) -> + _premisesIsimpleJudgements + {-# INLINE rule394 #-} + rule394 = \ ((_lhsInameMap) :: [(Name,Tp)]) -> + _lhsInameMap + {-# INLINE rule395 #-} + rule395 = \ ((_lhsIsimpleJudgements) :: [(String,Tp)]) -> + _lhsIsimpleJudgements + {-# INLINE rule396 #-} + rule396 = \ ((_lhsInameMap) :: [(Name,Tp)]) -> + _lhsInameMap + +-- Types ------------------------------------------------------- +-- wrapper +data Inh_Types = Inh_Types { } +data Syn_Types = Syn_Types { self_Syn_Types :: (Types), typevariables_Syn_Types :: (Names) } +{-# INLINABLE wrap_Types #-} +wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) +wrap_Types (T_Types act) (Inh_Types ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Types_vIn178 + (T_Types_vOut178 _lhsOself _lhsOtypevariables) <- return (inv_Types_s179 sem arg) + return (Syn_Types _lhsOself _lhsOtypevariables) + ) + +-- cata +{-# NOINLINE sem_Types #-} +sem_Types :: Types -> T_Types +sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) + +-- semantic domain +newtype T_Types = T_Types { + attach_T_Types :: Identity (T_Types_s179 ) + } +newtype T_Types_s179 = C_Types_s179 { + inv_Types_s179 :: (T_Types_v178 ) + } +data T_Types_s180 = C_Types_s180 +type T_Types_v178 = (T_Types_vIn178 ) -> (T_Types_vOut178 ) +data T_Types_vIn178 = T_Types_vIn178 +data T_Types_vOut178 = T_Types_vOut178 (Types) (Names) +{-# NOINLINE sem_Types_Cons #-} +sem_Types_Cons :: T_Type -> T_Types -> T_Types +sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st179) where + {-# NOINLINE st179 #-} + st179 = let + v178 :: T_Types_v178 + v178 = \ (T_Types_vIn178 ) -> ( let + _hdX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) + _tlX179 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) + (T_Type_vOut172 _hdIself _hdItypevariables) = inv_Type_s173 _hdX173 (T_Type_vIn172 ) + (T_Types_vOut178 _tlIself _tlItypevariables) = inv_Types_s179 _tlX179 (T_Types_vIn178 ) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule397 _hdItypevariables _tlItypevariables + _self = rule398 _hdIself _tlIself + _lhsOself :: Types + _lhsOself = rule399 _self + __result_ = T_Types_vOut178 _lhsOself _lhsOtypevariables + in __result_ ) + in C_Types_s179 v178 + {-# INLINE rule397 #-} + rule397 = \ ((_hdItypevariables) :: Names) ((_tlItypevariables) :: Names) -> + _hdItypevariables ++ _tlItypevariables + {-# INLINE rule398 #-} + rule398 = \ ((_hdIself) :: Type) ((_tlIself) :: Types) -> + (:) _hdIself _tlIself + {-# INLINE rule399 #-} + rule399 = \ _self -> + _self +{-# NOINLINE sem_Types_Nil #-} +sem_Types_Nil :: T_Types +sem_Types_Nil = T_Types (return st179) where + {-# NOINLINE st179 #-} + st179 = let + v178 :: T_Types_v178 + v178 = \ (T_Types_vIn178 ) -> ( let + _lhsOtypevariables :: Names + _lhsOtypevariables = rule400 () + _self = rule401 () + _lhsOself :: Types + _lhsOself = rule402 _self + __result_ = T_Types_vOut178 _lhsOself _lhsOtypevariables + in __result_ ) + in C_Types_s179 v178 + {-# INLINE rule400 #-} + rule400 = \ (_ :: ()) -> + [] + {-# INLINE rule401 #-} + rule401 = \ (_ :: ()) -> + [] + {-# INLINE rule402 #-} + rule402 = \ _self -> + _self + +-- TypingStrategies -------------------------------------------- +-- wrapper +data Inh_TypingStrategies = Inh_TypingStrategies { } +data Syn_TypingStrategies = Syn_TypingStrategies { self_Syn_TypingStrategies :: (TypingStrategies) } +{-# INLINABLE wrap_TypingStrategies #-} +wrap_TypingStrategies :: T_TypingStrategies -> Inh_TypingStrategies -> (Syn_TypingStrategies ) +wrap_TypingStrategies (T_TypingStrategies act) (Inh_TypingStrategies ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_TypingStrategies_vIn181 + (T_TypingStrategies_vOut181 _lhsOself) <- return (inv_TypingStrategies_s182 sem arg) + return (Syn_TypingStrategies _lhsOself) + ) + +-- cata +{-# NOINLINE sem_TypingStrategies #-} +sem_TypingStrategies :: TypingStrategies -> T_TypingStrategies +sem_TypingStrategies list = Prelude.foldr sem_TypingStrategies_Cons sem_TypingStrategies_Nil (Prelude.map sem_TypingStrategy list) + +-- semantic domain +newtype T_TypingStrategies = T_TypingStrategies { + attach_T_TypingStrategies :: Identity (T_TypingStrategies_s182 ) + } +newtype T_TypingStrategies_s182 = C_TypingStrategies_s182 { + inv_TypingStrategies_s182 :: (T_TypingStrategies_v181 ) + } +data T_TypingStrategies_s183 = C_TypingStrategies_s183 +type T_TypingStrategies_v181 = (T_TypingStrategies_vIn181 ) -> (T_TypingStrategies_vOut181 ) +data T_TypingStrategies_vIn181 = T_TypingStrategies_vIn181 +data T_TypingStrategies_vOut181 = T_TypingStrategies_vOut181 (TypingStrategies) +{-# NOINLINE sem_TypingStrategies_Cons #-} +sem_TypingStrategies_Cons :: T_TypingStrategy -> T_TypingStrategies -> T_TypingStrategies +sem_TypingStrategies_Cons arg_hd_ arg_tl_ = T_TypingStrategies (return st182) where + {-# NOINLINE st182 #-} + st182 = let + v181 :: T_TypingStrategies_v181 + v181 = \ (T_TypingStrategies_vIn181 ) -> ( let + _hdX185 = Control.Monad.Identity.runIdentity (attach_T_TypingStrategy (arg_hd_)) + _tlX182 = Control.Monad.Identity.runIdentity (attach_T_TypingStrategies (arg_tl_)) + (T_TypingStrategy_vOut184 _hdIerrors _hdIself _hdIwarnings) = inv_TypingStrategy_s185 _hdX185 (T_TypingStrategy_vIn184 _hdOimportEnvironment) + (T_TypingStrategies_vOut181 _tlIself) = inv_TypingStrategies_s182 _tlX182 (T_TypingStrategies_vIn181 ) + _importEnvironment = rule403 () + _self = rule404 _hdIself _tlIself + _lhsOself :: TypingStrategies + _lhsOself = rule405 _self + _hdOimportEnvironment = rule406 _importEnvironment + __result_ = T_TypingStrategies_vOut181 _lhsOself + in __result_ ) + in C_TypingStrategies_s182 v181 + {-# INLINE rule403 #-} + rule403 = \ (_ :: ()) -> + internalError "TS_Analyse.ag" "n/a" "TS_Analyse.ag" + {-# INLINE rule404 #-} + rule404 = \ ((_hdIself) :: TypingStrategy) ((_tlIself) :: TypingStrategies) -> + (:) _hdIself _tlIself + {-# INLINE rule405 #-} + rule405 = \ _self -> + _self + {-# INLINE rule406 #-} + rule406 = \ _importEnvironment -> + _importEnvironment +{-# NOINLINE sem_TypingStrategies_Nil #-} +sem_TypingStrategies_Nil :: T_TypingStrategies +sem_TypingStrategies_Nil = T_TypingStrategies (return st182) where + {-# NOINLINE st182 #-} + st182 = let + v181 :: T_TypingStrategies_v181 + v181 = \ (T_TypingStrategies_vIn181 ) -> ( let + _self = rule407 () + _lhsOself :: TypingStrategies + _lhsOself = rule408 _self + __result_ = T_TypingStrategies_vOut181 _lhsOself + in __result_ ) + in C_TypingStrategies_s182 v181 + {-# INLINE rule407 #-} + rule407 = \ (_ :: ()) -> + [] + {-# INLINE rule408 #-} + rule408 = \ _self -> + _self + +-- TypingStrategy ---------------------------------------------- +-- wrapper +data Inh_TypingStrategy = Inh_TypingStrategy { importEnvironment_Inh_TypingStrategy :: (ImportEnvironment) } +data Syn_TypingStrategy = Syn_TypingStrategy { errors_Syn_TypingStrategy :: (TS_Errors), self_Syn_TypingStrategy :: (TypingStrategy), warnings_Syn_TypingStrategy :: (TS_Warnings) } +{-# INLINABLE wrap_TypingStrategy #-} +wrap_TypingStrategy :: T_TypingStrategy -> Inh_TypingStrategy -> (Syn_TypingStrategy ) +wrap_TypingStrategy (T_TypingStrategy act) (Inh_TypingStrategy _lhsIimportEnvironment) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_TypingStrategy_vIn184 _lhsIimportEnvironment + (T_TypingStrategy_vOut184 _lhsOerrors _lhsOself _lhsOwarnings) <- return (inv_TypingStrategy_s185 sem arg) + return (Syn_TypingStrategy _lhsOerrors _lhsOself _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_TypingStrategy #-} +sem_TypingStrategy :: TypingStrategy -> T_TypingStrategy +sem_TypingStrategy ( TypingStrategy_Siblings names_ ) = sem_TypingStrategy_Siblings ( sem_Names names_ ) +sem_TypingStrategy ( TypingStrategy_TypingStrategy typerule_ statements_ ) = sem_TypingStrategy_TypingStrategy ( sem_TypeRule typerule_ ) ( sem_UserStatements statements_ ) + +-- semantic domain +newtype T_TypingStrategy = T_TypingStrategy { + attach_T_TypingStrategy :: Identity (T_TypingStrategy_s185 ) + } +newtype T_TypingStrategy_s185 = C_TypingStrategy_s185 { + inv_TypingStrategy_s185 :: (T_TypingStrategy_v184 ) + } +data T_TypingStrategy_s186 = C_TypingStrategy_s186 +type T_TypingStrategy_v184 = (T_TypingStrategy_vIn184 ) -> (T_TypingStrategy_vOut184 ) +data T_TypingStrategy_vIn184 = T_TypingStrategy_vIn184 (ImportEnvironment) +data T_TypingStrategy_vOut184 = T_TypingStrategy_vOut184 (TS_Errors) (TypingStrategy) (TS_Warnings) +{-# NOINLINE sem_TypingStrategy_Siblings #-} +sem_TypingStrategy_Siblings :: T_Names -> T_TypingStrategy +sem_TypingStrategy_Siblings arg_names_ = T_TypingStrategy (return st185) where + {-# NOINLINE st185 #-} + st185 = let + v184 :: T_TypingStrategy_v184 + v184 = \ (T_TypingStrategy_vIn184 _lhsIimportEnvironment) -> ( let + _namesX119 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + (T_Names_vOut118 _namesIself) = inv_Names_s119 _namesX119 (T_Names_vIn118 ) + _lhsOerrors :: TS_Errors + _lhsOerrors = rule409 () + _lhsOwarnings :: TS_Warnings + _lhsOwarnings = rule410 () + _self = rule411 _namesIself + _lhsOself :: TypingStrategy + _lhsOself = rule412 _self + __result_ = T_TypingStrategy_vOut184 _lhsOerrors _lhsOself _lhsOwarnings + in __result_ ) + in C_TypingStrategy_s185 v184 + {-# INLINE rule409 #-} + rule409 = \ (_ :: ()) -> + [] + {-# INLINE rule410 #-} + rule410 = \ (_ :: ()) -> + [] + {-# INLINE rule411 #-} + rule411 = \ ((_namesIself) :: Names) -> + TypingStrategy_Siblings _namesIself + {-# INLINE rule412 #-} + rule412 = \ _self -> + _self +{-# NOINLINE sem_TypingStrategy_TypingStrategy #-} +sem_TypingStrategy_TypingStrategy :: T_TypeRule -> T_UserStatements -> T_TypingStrategy +sem_TypingStrategy_TypingStrategy arg_typerule_ arg_statements_ = T_TypingStrategy (return st185) where + {-# NOINLINE st185 #-} + st185 = let + v184 :: T_TypingStrategy_v184 + v184 = \ (T_TypingStrategy_vIn184 _lhsIimportEnvironment) -> ( let + _typeruleX176 = Control.Monad.Identity.runIdentity (attach_T_TypeRule (arg_typerule_)) + _statementsX191 = Control.Monad.Identity.runIdentity (attach_T_UserStatements (arg_statements_)) + (T_TypeRule_vOut175 _typeruleIconclusionAllVariables _typeruleIconclusionExpression _typeruleIconclusionType _typeruleIself _typeruleIsimpleJudgements _typeruleItypevariables) = inv_TypeRule_s176 _typeruleX176 (T_TypeRule_vIn175 _typeruleOnameMap _typeruleOsimpleJudgements) + (T_UserStatements_vOut190 _statementsImetaVariableConstraintNames _statementsIself _statementsItypevariables _statementsIuserConstraints _statementsIuserPredicates) = inv_UserStatements_s191 _statementsX191 (T_UserStatements_vIn190 _statementsOattributeTable _statementsOmetaVariableConstraintNames _statementsOnameMap _statementsOstandardConstraintInfo _statementsOuserConstraints _statementsOuserPredicates) + _name = rule413 _typeruleIconclusionExpression + _nameMap = rule414 _uniqueTypevariables + _errors = rule415 _soundnessErrors _staticErrors + _staticErrors = rule416 _allImportedVariables _allMetaVariables _name _solveErrors _statementsImetaVariableConstraintNames _typeruleIconclusionAllVariables + _warnings = rule417 () + _substitution = rule418 _solveResult + _solveErrors = rule419 _solveResult + _solveResult = rule420 _classEnv _lhsIimportEnvironment _statementsIuserConstraints _uniqueTypevariables + _classEnv = rule421 _lhsIimportEnvironment + _soundnessErrors = rule422 _classEnv _lhsIimportEnvironment _name _statementsIuserPredicates _staticErrors _substitution _typeruleIconclusionExpression _typeruleIconclusionType _typeruleIsimpleJudgements + _allImportedVariables = rule423 _lhsIimportEnvironment + _uniqueTypevariables = rule424 _statementsItypevariables _typeruleItypevariables + _statementsOuserConstraints = rule425 () + _statementsOuserPredicates = rule426 () + _typeruleOsimpleJudgements = rule427 () + _statementsOmetaVariableConstraintNames = rule428 () + _allMetaVariables = rule429 _typeruleIsimpleJudgements + _constraintsNotExplicit = rule430 _allMetaVariables _statementsImetaVariableConstraintNames + _standardConstraintInfo = rule431 () + _attributeTable = rule432 () + _self = rule433 _statementsIself _typeruleIself + _lhsOself :: TypingStrategy + _lhsOself = rule434 _self + _lhsOerrors :: TS_Errors + _lhsOerrors = rule435 _errors + _lhsOwarnings :: TS_Warnings + _lhsOwarnings = rule436 _warnings + _typeruleOnameMap = rule437 _nameMap + _statementsOattributeTable = rule438 _attributeTable + _statementsOnameMap = rule439 _nameMap + _statementsOstandardConstraintInfo = rule440 _standardConstraintInfo + __result_ = T_TypingStrategy_vOut184 _lhsOerrors _lhsOself _lhsOwarnings + in __result_ ) + in C_TypingStrategy_s185 v184 + {-# INLINE rule413 #-} + rule413 = \ ((_typeruleIconclusionExpression) :: Expression) -> + show (PP.text_Syn_Expression $ PP.wrap_Expression (PP.sem_Expression _typeruleIconclusionExpression) PP.Inh_Expression) + {-# INLINE rule414 #-} + rule414 = \ _uniqueTypevariables -> + zip _uniqueTypevariables (map TVar [0..]) + {-# INLINE rule415 #-} + rule415 = \ _soundnessErrors _staticErrors -> + _staticErrors ++ _soundnessErrors + {-# INLINE rule416 #-} + rule416 = \ _allImportedVariables _allMetaVariables _name _solveErrors ((_statementsImetaVariableConstraintNames) :: Names) ((_typeruleIconclusionAllVariables) :: [(Name,Entity)]) -> + [ InconsistentConstraint _name x | (x, _) <- _solveErrors ] ++ + [ UndefinedTS _name name entity + | (name, entity) <- _typeruleIconclusionAllVariables + , show name `notElem` (_allMetaVariables ++ map show _allImportedVariables) + ] ++ + [ UnusedMetaVariable _name s + | s <- _allMetaVariables + , s `notElem` (map (show . fst) _typeruleIconclusionAllVariables) + ] ++ + [ DuplicatedMetaVariablesPremise _name x + | x:_ <- findDuplicates _allMetaVariables + ] ++ + [ DuplicatedMetaVariablesConclusion _name x + | let strings = map (show . fst) _typeruleIconclusionAllVariables + , x:_ <- findDuplicates (filter (`elem` _allMetaVariables) strings) + ] ++ + [ DuplicatedMetaVariableConstraints _name (show x) + | x:_ <- findDuplicates _statementsImetaVariableConstraintNames + ] + {-# INLINE rule417 #-} + rule417 = \ (_ :: ()) -> + [] + {-# INLINE rule418 #-} + rule418 = \ _solveResult -> + substitutionFromResult _solveResult + {-# INLINE rule419 #-} + rule419 = \ _solveResult -> + errorsFromResult _solveResult + {-# INLINE rule420 #-} + rule420 = \ _classEnv ((_lhsIimportEnvironment) :: ImportEnvironment) ((_statementsIuserConstraints) :: TypeConstraints ConstraintInfo) _uniqueTypevariables -> + let options = solveOptions { uniqueCounter = length _uniqueTypevariables + , Top.Solver.typeSynonyms = getOrderedTypeSynonyms _lhsIimportEnvironment + , classEnvironment = _classEnv + } + in fst (solve options (reverse _statementsIuserConstraints) greedyConstraintSolver) + {-# INLINE rule421 #-} + rule421 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + createClassEnvironment _lhsIimportEnvironment + {-# INLINE rule422 #-} + rule422 = \ _classEnv ((_lhsIimportEnvironment) :: ImportEnvironment) _name ((_statementsIuserPredicates) :: Predicates) _staticErrors _substitution ((_typeruleIconclusionExpression) :: Expression) ((_typeruleIconclusionType) :: Tp) ((_typeruleIsimpleJudgements) :: [(String,Tp)]) -> + if not (null _staticErrors) + then [] + else let orderedMetaList = + reverse _typeruleIsimpleJudgements + constraintsTpScheme = + let premiseTypes = map snd orderedMetaList + skeletonType = foldr (.->.) _typeruleIconclusionType premiseTypes + in generalizeAll (_substitution |-> (_statementsIuserPredicates .=>. skeletonType)) + (inferredTpScheme, _, inferredTypeErrors) = + let expr = Expression_Lambda noRange pats _typeruleIconclusionExpression + pats = map (Pattern_Variable noRange . nameFromString . fst) orderedMetaList + in expressionTypeInferencer _lhsIimportEnvironment expr + synonyms = getOrderedTypeSynonyms _lhsIimportEnvironment + in if not (null inferredTypeErrors) + then map (TypeErrorTS _name) inferredTypeErrors + else if genericInstanceOf synonyms _classEnv inferredTpScheme constraintsTpScheme + && + genericInstanceOf synonyms _classEnv constraintsTpScheme inferredTpScheme + then [] + else [ Soundness _name inferredTpScheme constraintsTpScheme ] + {-# INLINE rule423 #-} + rule423 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + M.keys (typeEnvironment _lhsIimportEnvironment) ++ + M.keys (valueConstructors _lhsIimportEnvironment) + {-# INLINE rule424 #-} + rule424 = \ ((_statementsItypevariables) :: Names) ((_typeruleItypevariables) :: Names) -> + nub (_typeruleItypevariables ++ _statementsItypevariables) + {-# INLINE rule425 #-} + rule425 = \ (_ :: ()) -> + [] + {-# INLINE rule426 #-} + rule426 = \ (_ :: ()) -> + [] + {-# INLINE rule427 #-} + rule427 = \ (_ :: ()) -> + [] + {-# INLINE rule428 #-} + rule428 = \ (_ :: ()) -> + [] + {-# INLINE rule429 #-} + rule429 = \ ((_typeruleIsimpleJudgements) :: [(String,Tp)]) -> + map fst _typeruleIsimpleJudgements + {-# INLINE rule430 #-} + rule430 = \ _allMetaVariables ((_statementsImetaVariableConstraintNames) :: Names) -> + filter (`notElem` (map show _statementsImetaVariableConstraintNames)) _allMetaVariables + {-# INLINE rule431 #-} + rule431 = \ (_ :: ()) -> + standardConstraintInfo + {-# INLINE rule432 #-} + rule432 = \ (_ :: ()) -> + [] + {-# INLINE rule433 #-} + rule433 = \ ((_statementsIself) :: UserStatements) ((_typeruleIself) :: TypeRule) -> + TypingStrategy_TypingStrategy _typeruleIself _statementsIself + {-# INLINE rule434 #-} + rule434 = \ _self -> + _self + {-# INLINE rule435 #-} + rule435 = \ _errors -> + _errors + {-# INLINE rule436 #-} + rule436 = \ _warnings -> + _warnings + {-# INLINE rule437 #-} + rule437 = \ _nameMap -> + _nameMap + {-# INLINE rule438 #-} + rule438 = \ _attributeTable -> + _attributeTable + {-# INLINE rule439 #-} + rule439 = \ _nameMap -> + _nameMap + {-# INLINE rule440 #-} + rule440 = \ _standardConstraintInfo -> + _standardConstraintInfo + +-- UserStatement ----------------------------------------------- +-- wrapper +data Inh_UserStatement = Inh_UserStatement { attributeTable_Inh_UserStatement :: ([((String, Maybe String), MessageBlock)]), metaVariableConstraintNames_Inh_UserStatement :: (Names), nameMap_Inh_UserStatement :: ([(Name,Tp)]), standardConstraintInfo_Inh_UserStatement :: (ConstraintInfo), userConstraints_Inh_UserStatement :: (TypeConstraints ConstraintInfo), userPredicates_Inh_UserStatement :: (Predicates) } +data Syn_UserStatement = Syn_UserStatement { metaVariableConstraintNames_Syn_UserStatement :: (Names), self_Syn_UserStatement :: (UserStatement), typevariables_Syn_UserStatement :: (Names), userConstraints_Syn_UserStatement :: (TypeConstraints ConstraintInfo), userPredicates_Syn_UserStatement :: (Predicates) } +{-# INLINABLE wrap_UserStatement #-} +wrap_UserStatement :: T_UserStatement -> Inh_UserStatement -> (Syn_UserStatement ) +wrap_UserStatement (T_UserStatement act) (Inh_UserStatement _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_UserStatement_vIn187 _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates + (T_UserStatement_vOut187 _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates) <- return (inv_UserStatement_s188 sem arg) + return (Syn_UserStatement _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates) + ) + +-- cata +{-# NOINLINE sem_UserStatement #-} +sem_UserStatement :: UserStatement -> T_UserStatement +sem_UserStatement ( UserStatement_Equal leftType_ rightType_ message_ ) = sem_UserStatement_Equal ( sem_Type leftType_ ) ( sem_Type rightType_ ) message_ +sem_UserStatement ( UserStatement_Pred predClass_ predType_ message_ ) = sem_UserStatement_Pred ( sem_Name predClass_ ) ( sem_Type predType_ ) message_ +sem_UserStatement ( UserStatement_MetaVariableConstraints name_ ) = sem_UserStatement_MetaVariableConstraints ( sem_Name name_ ) +sem_UserStatement ( UserStatement_Phase phase_ ) = sem_UserStatement_Phase phase_ + +-- semantic domain +newtype T_UserStatement = T_UserStatement { + attach_T_UserStatement :: Identity (T_UserStatement_s188 ) + } +newtype T_UserStatement_s188 = C_UserStatement_s188 { + inv_UserStatement_s188 :: (T_UserStatement_v187 ) + } +data T_UserStatement_s189 = C_UserStatement_s189 +type T_UserStatement_v187 = (T_UserStatement_vIn187 ) -> (T_UserStatement_vOut187 ) +data T_UserStatement_vIn187 = T_UserStatement_vIn187 ([((String, Maybe String), MessageBlock)]) (Names) ([(Name,Tp)]) (ConstraintInfo) (TypeConstraints ConstraintInfo) (Predicates) +data T_UserStatement_vOut187 = T_UserStatement_vOut187 (Names) (UserStatement) (Names) (TypeConstraints ConstraintInfo) (Predicates) +{-# NOINLINE sem_UserStatement_Equal #-} +sem_UserStatement_Equal :: T_Type -> T_Type -> (String) -> T_UserStatement +sem_UserStatement_Equal arg_leftType_ arg_rightType_ arg_message_ = T_UserStatement (return st188) where + {-# NOINLINE st188 #-} + st188 = let + v187 :: T_UserStatement_v187 + v187 = \ (T_UserStatement_vIn187 _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates) -> ( let + _leftTypeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_leftType_)) + _rightTypeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_rightType_)) + (T_Type_vOut172 _leftTypeIself _leftTypeItypevariables) = inv_Type_s173 _leftTypeX173 (T_Type_vIn172 ) + (T_Type_vOut172 _rightTypeIself _rightTypeItypevariables) = inv_Type_s173 _rightTypeX173 (T_Type_vIn172 ) + _lhsOuserConstraints :: TypeConstraints ConstraintInfo + _lhsOuserConstraints = rule441 _lhsIuserConstraints _newConstraint + _newConstraint = rule442 _leftTypeIself _lhsInameMap _lhsIstandardConstraintInfo _rightTypeIself + _lhsOtypevariables :: Names + _lhsOtypevariables = rule443 _leftTypeItypevariables _rightTypeItypevariables + _self = rule444 _leftTypeIself _rightTypeIself arg_message_ + _lhsOself :: UserStatement + _lhsOself = rule445 _self + _lhsOmetaVariableConstraintNames :: Names + _lhsOmetaVariableConstraintNames = rule446 _lhsImetaVariableConstraintNames + _lhsOuserPredicates :: Predicates + _lhsOuserPredicates = rule447 _lhsIuserPredicates + __result_ = T_UserStatement_vOut187 _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates + in __result_ ) + in C_UserStatement_s188 v187 + {-# INLINE rule441 #-} + rule441 = \ ((_lhsIuserConstraints) :: TypeConstraints ConstraintInfo) _newConstraint -> + _newConstraint : _lhsIuserConstraints + {-# INLINE rule442 #-} + rule442 = \ ((_leftTypeIself) :: Type) ((_lhsInameMap) :: [(Name,Tp)]) ((_lhsIstandardConstraintInfo) :: ConstraintInfo) ((_rightTypeIself) :: Type) -> + (makeTpFromType _lhsInameMap _leftTypeIself .==. makeTpFromType _lhsInameMap _rightTypeIself) _lhsIstandardConstraintInfo + {-# INLINE rule443 #-} + rule443 = \ ((_leftTypeItypevariables) :: Names) ((_rightTypeItypevariables) :: Names) -> + _leftTypeItypevariables ++ _rightTypeItypevariables + {-# INLINE rule444 #-} + rule444 = \ ((_leftTypeIself) :: Type) ((_rightTypeIself) :: Type) message_ -> + UserStatement_Equal _leftTypeIself _rightTypeIself message_ + {-# INLINE rule445 #-} + rule445 = \ _self -> + _self + {-# INLINE rule446 #-} + rule446 = \ ((_lhsImetaVariableConstraintNames) :: Names) -> + _lhsImetaVariableConstraintNames + {-# INLINE rule447 #-} + rule447 = \ ((_lhsIuserPredicates) :: Predicates) -> + _lhsIuserPredicates +{-# NOINLINE sem_UserStatement_Pred #-} +sem_UserStatement_Pred :: T_Name -> T_Type -> (String) -> T_UserStatement +sem_UserStatement_Pred arg_predClass_ arg_predType_ arg_message_ = T_UserStatement (return st188) where + {-# NOINLINE st188 #-} + st188 = let + v187 :: T_UserStatement_v187 + v187 = \ (T_UserStatement_vIn187 _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates) -> ( let + _predClassX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_predClass_)) + _predTypeX173 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_predType_)) + (T_Name_vOut115 _predClassIself) = inv_Name_s116 _predClassX116 (T_Name_vIn115 ) + (T_Type_vOut172 _predTypeIself _predTypeItypevariables) = inv_Type_s173 _predTypeX173 (T_Type_vIn172 ) + _lhsOuserPredicates :: Predicates + _lhsOuserPredicates = rule448 _lhsIuserPredicates _newPredicate + _newPredicate = rule449 _lhsInameMap _predClassIself _predTypeIself + _lhsOtypevariables :: Names + _lhsOtypevariables = rule450 _predTypeItypevariables + _self = rule451 _predClassIself _predTypeIself arg_message_ + _lhsOself :: UserStatement + _lhsOself = rule452 _self + _lhsOmetaVariableConstraintNames :: Names + _lhsOmetaVariableConstraintNames = rule453 _lhsImetaVariableConstraintNames + _lhsOuserConstraints :: TypeConstraints ConstraintInfo + _lhsOuserConstraints = rule454 _lhsIuserConstraints + __result_ = T_UserStatement_vOut187 _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates + in __result_ ) + in C_UserStatement_s188 v187 + {-# INLINE rule448 #-} + rule448 = \ ((_lhsIuserPredicates) :: Predicates) _newPredicate -> + _newPredicate : _lhsIuserPredicates + {-# INLINE rule449 #-} + rule449 = \ ((_lhsInameMap) :: [(Name,Tp)]) ((_predClassIself) :: Name) ((_predTypeIself) :: Type) -> + Predicate (show _predClassIself) (makeTpFromType _lhsInameMap _predTypeIself) + {-# INLINE rule450 #-} + rule450 = \ ((_predTypeItypevariables) :: Names) -> + _predTypeItypevariables + {-# INLINE rule451 #-} + rule451 = \ ((_predClassIself) :: Name) ((_predTypeIself) :: Type) message_ -> + UserStatement_Pred _predClassIself _predTypeIself message_ + {-# INLINE rule452 #-} + rule452 = \ _self -> + _self + {-# INLINE rule453 #-} + rule453 = \ ((_lhsImetaVariableConstraintNames) :: Names) -> + _lhsImetaVariableConstraintNames + {-# INLINE rule454 #-} + rule454 = \ ((_lhsIuserConstraints) :: TypeConstraints ConstraintInfo) -> + _lhsIuserConstraints +{-# NOINLINE sem_UserStatement_MetaVariableConstraints #-} +sem_UserStatement_MetaVariableConstraints :: T_Name -> T_UserStatement +sem_UserStatement_MetaVariableConstraints arg_name_ = T_UserStatement (return st188) where + {-# NOINLINE st188 #-} + st188 = let + v187 :: T_UserStatement_v187 + v187 = \ (T_UserStatement_vIn187 _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates) -> ( let + _nameX116 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Name_vOut115 _nameIself) = inv_Name_s116 _nameX116 (T_Name_vIn115 ) + _lhsOmetaVariableConstraintNames :: Names + _lhsOmetaVariableConstraintNames = rule455 _lhsImetaVariableConstraintNames _nameIself + _lhsOtypevariables :: Names + _lhsOtypevariables = rule456 () + _self = rule457 _nameIself + _lhsOself :: UserStatement + _lhsOself = rule458 _self + _lhsOuserConstraints :: TypeConstraints ConstraintInfo + _lhsOuserConstraints = rule459 _lhsIuserConstraints + _lhsOuserPredicates :: Predicates + _lhsOuserPredicates = rule460 _lhsIuserPredicates + __result_ = T_UserStatement_vOut187 _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates + in __result_ ) + in C_UserStatement_s188 v187 + {-# INLINE rule455 #-} + rule455 = \ ((_lhsImetaVariableConstraintNames) :: Names) ((_nameIself) :: Name) -> + _nameIself : _lhsImetaVariableConstraintNames + {-# INLINE rule456 #-} + rule456 = \ (_ :: ()) -> + [] + {-# INLINE rule457 #-} + rule457 = \ ((_nameIself) :: Name) -> + UserStatement_MetaVariableConstraints _nameIself + {-# INLINE rule458 #-} + rule458 = \ _self -> + _self + {-# INLINE rule459 #-} + rule459 = \ ((_lhsIuserConstraints) :: TypeConstraints ConstraintInfo) -> + _lhsIuserConstraints + {-# INLINE rule460 #-} + rule460 = \ ((_lhsIuserPredicates) :: Predicates) -> + _lhsIuserPredicates +{-# NOINLINE sem_UserStatement_Phase #-} +sem_UserStatement_Phase :: (Int) -> T_UserStatement +sem_UserStatement_Phase arg_phase_ = T_UserStatement (return st188) where + {-# NOINLINE st188 #-} + st188 = let + v187 :: T_UserStatement_v187 + v187 = \ (T_UserStatement_vIn187 _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates) -> ( let + _lhsOtypevariables :: Names + _lhsOtypevariables = rule461 () + _self = rule462 arg_phase_ + _lhsOself :: UserStatement + _lhsOself = rule463 _self + _lhsOmetaVariableConstraintNames :: Names + _lhsOmetaVariableConstraintNames = rule464 _lhsImetaVariableConstraintNames + _lhsOuserConstraints :: TypeConstraints ConstraintInfo + _lhsOuserConstraints = rule465 _lhsIuserConstraints + _lhsOuserPredicates :: Predicates + _lhsOuserPredicates = rule466 _lhsIuserPredicates + __result_ = T_UserStatement_vOut187 _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates + in __result_ ) + in C_UserStatement_s188 v187 + {-# INLINE rule461 #-} + rule461 = \ (_ :: ()) -> + [] + {-# INLINE rule462 #-} + rule462 = \ phase_ -> + UserStatement_Phase phase_ + {-# INLINE rule463 #-} + rule463 = \ _self -> + _self + {-# INLINE rule464 #-} + rule464 = \ ((_lhsImetaVariableConstraintNames) :: Names) -> + _lhsImetaVariableConstraintNames + {-# INLINE rule465 #-} + rule465 = \ ((_lhsIuserConstraints) :: TypeConstraints ConstraintInfo) -> + _lhsIuserConstraints + {-# INLINE rule466 #-} + rule466 = \ ((_lhsIuserPredicates) :: Predicates) -> + _lhsIuserPredicates + +-- UserStatements ---------------------------------------------- +-- wrapper +data Inh_UserStatements = Inh_UserStatements { attributeTable_Inh_UserStatements :: ([((String, Maybe String), MessageBlock)]), metaVariableConstraintNames_Inh_UserStatements :: (Names), nameMap_Inh_UserStatements :: ([(Name,Tp)]), standardConstraintInfo_Inh_UserStatements :: (ConstraintInfo), userConstraints_Inh_UserStatements :: (TypeConstraints ConstraintInfo), userPredicates_Inh_UserStatements :: (Predicates) } +data Syn_UserStatements = Syn_UserStatements { metaVariableConstraintNames_Syn_UserStatements :: (Names), self_Syn_UserStatements :: (UserStatements), typevariables_Syn_UserStatements :: (Names), userConstraints_Syn_UserStatements :: (TypeConstraints ConstraintInfo), userPredicates_Syn_UserStatements :: (Predicates) } +{-# INLINABLE wrap_UserStatements #-} +wrap_UserStatements :: T_UserStatements -> Inh_UserStatements -> (Syn_UserStatements ) +wrap_UserStatements (T_UserStatements act) (Inh_UserStatements _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_UserStatements_vIn190 _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates + (T_UserStatements_vOut190 _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates) <- return (inv_UserStatements_s191 sem arg) + return (Syn_UserStatements _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates) + ) + +-- cata +{-# NOINLINE sem_UserStatements #-} +sem_UserStatements :: UserStatements -> T_UserStatements +sem_UserStatements list = Prelude.foldr sem_UserStatements_Cons sem_UserStatements_Nil (Prelude.map sem_UserStatement list) + +-- semantic domain +newtype T_UserStatements = T_UserStatements { + attach_T_UserStatements :: Identity (T_UserStatements_s191 ) + } +newtype T_UserStatements_s191 = C_UserStatements_s191 { + inv_UserStatements_s191 :: (T_UserStatements_v190 ) + } +data T_UserStatements_s192 = C_UserStatements_s192 +type T_UserStatements_v190 = (T_UserStatements_vIn190 ) -> (T_UserStatements_vOut190 ) +data T_UserStatements_vIn190 = T_UserStatements_vIn190 ([((String, Maybe String), MessageBlock)]) (Names) ([(Name,Tp)]) (ConstraintInfo) (TypeConstraints ConstraintInfo) (Predicates) +data T_UserStatements_vOut190 = T_UserStatements_vOut190 (Names) (UserStatements) (Names) (TypeConstraints ConstraintInfo) (Predicates) +{-# NOINLINE sem_UserStatements_Cons #-} +sem_UserStatements_Cons :: T_UserStatement -> T_UserStatements -> T_UserStatements +sem_UserStatements_Cons arg_hd_ arg_tl_ = T_UserStatements (return st191) where + {-# NOINLINE st191 #-} + st191 = let + v190 :: T_UserStatements_v190 + v190 = \ (T_UserStatements_vIn190 _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates) -> ( let + _hdX188 = Control.Monad.Identity.runIdentity (attach_T_UserStatement (arg_hd_)) + _tlX191 = Control.Monad.Identity.runIdentity (attach_T_UserStatements (arg_tl_)) + (T_UserStatement_vOut187 _hdImetaVariableConstraintNames _hdIself _hdItypevariables _hdIuserConstraints _hdIuserPredicates) = inv_UserStatement_s188 _hdX188 (T_UserStatement_vIn187 _hdOattributeTable _hdOmetaVariableConstraintNames _hdOnameMap _hdOstandardConstraintInfo _hdOuserConstraints _hdOuserPredicates) + (T_UserStatements_vOut190 _tlImetaVariableConstraintNames _tlIself _tlItypevariables _tlIuserConstraints _tlIuserPredicates) = inv_UserStatements_s191 _tlX191 (T_UserStatements_vIn190 _tlOattributeTable _tlOmetaVariableConstraintNames _tlOnameMap _tlOstandardConstraintInfo _tlOuserConstraints _tlOuserPredicates) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule467 _hdItypevariables _tlItypevariables + _self = rule468 _hdIself _tlIself + _lhsOself :: UserStatements + _lhsOself = rule469 _self + _lhsOmetaVariableConstraintNames :: Names + _lhsOmetaVariableConstraintNames = rule470 _tlImetaVariableConstraintNames + _lhsOuserConstraints :: TypeConstraints ConstraintInfo + _lhsOuserConstraints = rule471 _tlIuserConstraints + _lhsOuserPredicates :: Predicates + _lhsOuserPredicates = rule472 _tlIuserPredicates + _hdOattributeTable = rule473 _lhsIattributeTable + _hdOmetaVariableConstraintNames = rule474 _lhsImetaVariableConstraintNames + _hdOnameMap = rule475 _lhsInameMap + _hdOstandardConstraintInfo = rule476 _lhsIstandardConstraintInfo + _hdOuserConstraints = rule477 _lhsIuserConstraints + _hdOuserPredicates = rule478 _lhsIuserPredicates + _tlOattributeTable = rule479 _lhsIattributeTable + _tlOmetaVariableConstraintNames = rule480 _hdImetaVariableConstraintNames + _tlOnameMap = rule481 _lhsInameMap + _tlOstandardConstraintInfo = rule482 _lhsIstandardConstraintInfo + _tlOuserConstraints = rule483 _hdIuserConstraints + _tlOuserPredicates = rule484 _hdIuserPredicates + __result_ = T_UserStatements_vOut190 _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates + in __result_ ) + in C_UserStatements_s191 v190 + {-# INLINE rule467 #-} + rule467 = \ ((_hdItypevariables) :: Names) ((_tlItypevariables) :: Names) -> + _hdItypevariables ++ _tlItypevariables + {-# INLINE rule468 #-} + rule468 = \ ((_hdIself) :: UserStatement) ((_tlIself) :: UserStatements) -> + (:) _hdIself _tlIself + {-# INLINE rule469 #-} + rule469 = \ _self -> + _self + {-# INLINE rule470 #-} + rule470 = \ ((_tlImetaVariableConstraintNames) :: Names) -> + _tlImetaVariableConstraintNames + {-# INLINE rule471 #-} + rule471 = \ ((_tlIuserConstraints) :: TypeConstraints ConstraintInfo) -> + _tlIuserConstraints + {-# INLINE rule472 #-} + rule472 = \ ((_tlIuserPredicates) :: Predicates) -> + _tlIuserPredicates + {-# INLINE rule473 #-} + rule473 = \ ((_lhsIattributeTable) :: [((String, Maybe String), MessageBlock)]) -> + _lhsIattributeTable + {-# INLINE rule474 #-} + rule474 = \ ((_lhsImetaVariableConstraintNames) :: Names) -> + _lhsImetaVariableConstraintNames + {-# INLINE rule475 #-} + rule475 = \ ((_lhsInameMap) :: [(Name,Tp)]) -> + _lhsInameMap + {-# INLINE rule476 #-} + rule476 = \ ((_lhsIstandardConstraintInfo) :: ConstraintInfo) -> + _lhsIstandardConstraintInfo + {-# INLINE rule477 #-} + rule477 = \ ((_lhsIuserConstraints) :: TypeConstraints ConstraintInfo) -> + _lhsIuserConstraints + {-# INLINE rule478 #-} + rule478 = \ ((_lhsIuserPredicates) :: Predicates) -> + _lhsIuserPredicates + {-# INLINE rule479 #-} + rule479 = \ ((_lhsIattributeTable) :: [((String, Maybe String), MessageBlock)]) -> + _lhsIattributeTable + {-# INLINE rule480 #-} + rule480 = \ ((_hdImetaVariableConstraintNames) :: Names) -> + _hdImetaVariableConstraintNames + {-# INLINE rule481 #-} + rule481 = \ ((_lhsInameMap) :: [(Name,Tp)]) -> + _lhsInameMap + {-# INLINE rule482 #-} + rule482 = \ ((_lhsIstandardConstraintInfo) :: ConstraintInfo) -> + _lhsIstandardConstraintInfo + {-# INLINE rule483 #-} + rule483 = \ ((_hdIuserConstraints) :: TypeConstraints ConstraintInfo) -> + _hdIuserConstraints + {-# INLINE rule484 #-} + rule484 = \ ((_hdIuserPredicates) :: Predicates) -> + _hdIuserPredicates +{-# NOINLINE sem_UserStatements_Nil #-} +sem_UserStatements_Nil :: T_UserStatements +sem_UserStatements_Nil = T_UserStatements (return st191) where + {-# NOINLINE st191 #-} + st191 = let + v190 :: T_UserStatements_v190 + v190 = \ (T_UserStatements_vIn190 _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates) -> ( let + _lhsOtypevariables :: Names + _lhsOtypevariables = rule485 () + _self = rule486 () + _lhsOself :: UserStatements + _lhsOself = rule487 _self + _lhsOmetaVariableConstraintNames :: Names + _lhsOmetaVariableConstraintNames = rule488 _lhsImetaVariableConstraintNames + _lhsOuserConstraints :: TypeConstraints ConstraintInfo + _lhsOuserConstraints = rule489 _lhsIuserConstraints + _lhsOuserPredicates :: Predicates + _lhsOuserPredicates = rule490 _lhsIuserPredicates + __result_ = T_UserStatements_vOut190 _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates + in __result_ ) + in C_UserStatements_s191 v190 + {-# INLINE rule485 #-} + rule485 = \ (_ :: ()) -> + [] + {-# INLINE rule486 #-} + rule486 = \ (_ :: ()) -> + [] + {-# INLINE rule487 #-} + rule487 = \ _self -> + _self + {-# INLINE rule488 #-} + rule488 = \ ((_lhsImetaVariableConstraintNames) :: Names) -> + _lhsImetaVariableConstraintNames + {-# INLINE rule489 #-} + rule489 = \ ((_lhsIuserConstraints) :: TypeConstraints ConstraintInfo) -> + _lhsIuserConstraints + {-# INLINE rule490 #-} + rule490 = \ ((_lhsIuserPredicates) :: Predicates) -> + _lhsIuserPredicates diff --git a/src/Helium/StaticAnalysis/Directives/TS_Apply.ag b/src/Helium/StaticAnalysis/Directives/TS_Apply.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_Apply.ag @@ -0,0 +1,238 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Apply specialized type rules during the type inference process. +-- +-- (directives based on "Scripting the Type Inference Process", ICFP 2003) +----------------------------------------------------------------------------- + +INCLUDE "TS_CoreSyntax.ag" + +imports { + +import Helium.Syntax.UHA_Syntax +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Data.List +import Helium.Utils.Utils (internalError) +import Helium.StaticAnalysis.Messages.Messages +import Helium.StaticAnalysis.Messages.TypeErrors +import Helium.ModuleSystem.ImportEnvironment +import Helium.StaticAnalysis.Inferencers.BindingGroupAnalysis (Assumptions, combine, noAssumptions) +import Helium.Parser.OperatorTable (OperatorTable) +import Helium.Parser.Parser (exp_) +import Helium.Parser.Lexer (strategiesLexer) +import Helium.Parser.ParseLibrary (runHParser) +import qualified Helium.Parser.ResolveOperators as ResolveOperators + +import qualified Data.Map as M +import Helium.StaticAnalysis.Directives.TS_Attributes +import Helium.StaticAnalysis.Directives.TS_CoreSyntax +import Top.Ordering.Tree +} + +{ +applyTypingStrategy :: Core_TypingStrategy -> MetaVariableInfo -> MetaVariableTable -> Int + -> (Assumptions, ConstraintSet, IO (), Int) +applyTypingStrategy strategy infoTuple metaVar unique = + let res = wrap_Core_TypingStrategy (sem_Core_TypingStrategy strategy) + Inh_Core_TypingStrategy { + infoTuple_Inh_Core_TypingStrategy = infoTuple, + metaVariableTable_Inh_Core_TypingStrategy = metaVar, + unique_Inh_Core_TypingStrategy = unique } + in (assumptions_Syn_Core_TypingStrategy res, constraintSet_Syn_Core_TypingStrategy res, debugIO_Syn_Core_TypingStrategy res, unique_Syn_Core_TypingStrategy res) + +matchInformation :: ImportEnvironment -> Core_TypingStrategy -> [(Expression, [String])] +matchInformation importEnvironment typingStrategy = + case typingStrategy of + TypingStrategy _ (TypeRule premises conclusion) _ -> + let Judgement exprstring _ = conclusion + expression = expressionParser (operatorTable importEnvironment) exprstring + metas = [ s | Judgement s _ <- premises ] + in [(expression, metas)] + _ -> [] + +expressionParser :: OperatorTable -> String -> Expression +expressionParser theOperatorTable string = + case strategiesLexer [] "TS_Apply" string of + Left _ -> intErr + Right (tokens, _) -> + case runHParser exp_ "TS_Apply" tokens True {- wait for EOF -} of + Left _ -> intErr + Right expression -> + ResolveOperators.expression theOperatorTable expression + where + intErr = internalError "TS_Apply.ag" "n/a" ("unparsable expression: "++show string) +} + +ATTR Core_TypingStrategy + [ infoTuple : MetaVariableInfo + metaVariableTable : MetaVariableTable + | unique : Int + | assumptions : Assumptions + constraintSet : ConstraintSet + debugIO : {IO ()} + ] + +SEM Core_TypingStrategy + | Siblings + lhs . assumptions = noAssumptions + . constraintSet = emptyTree + . debugIO = return () + | TypingStrategy + lhs . assumptions = foldr combine noAssumptions (map (getAssumptions . snd) @lhs.metaVariableTable) + . constraintSet = Node @allConstraintTrees + . unique = length @normalTV + @lhs.unique + . debugIO = putStrLn "applying typing strategy" + loc . substitution = listToSubstitution (@standardSubst ++ @specialSubst) + . allTV = @typerule.ftv `union` @statements.ftv `union` ftv (map snd @typeEnv) + +{- judgement with only a type variable should not introduce a new constraint -} + . specialTV = concat . exactlyOnce . map ftv . filter isTVar . map snd $ @typerule.judgements + . normalTV = @allTV \\ @specialTV + + . standardSubst = zip @normalTV (map TVar [@lhs.unique..]) + . specialSubst = let conclusionVar = case snd (last @typerule.judgements) of + TVar i -> Just i + _ -> Nothing + find' i | Just i == conclusionVar = [ (i, getType @lhs.infoTuple) ] + | otherwise = [ (i, getType infoTuple) + | (s1, TVar j) <- @typerule.judgements + , i == j + , (s2,infoTuple) <- @lhs.metaVariableTable + , s1 == s2 + ] + in concatMap find' @specialTV + + +ATTR Core_TypeRule Core_Judgements Core_Judgement Core_UserStatements Core_UserStatement + [ substitution : MapSubstitution + infoTuple : MetaVariableInfo + metaVariableTable : MetaVariableTable + | + | ftv USE {`union`} {[]} : {[Int]} + ] + +SEM Core_UserStatement + | Equal lhs . ftv = ftv [@leftType, @rightType] + +SEM Core_Judgement + | Judgement lhs . ftv = ftv @type + +ATTR Core_UserStatements Core_UserStatement + [ fromAttribute : {Attribute -> MessageBlock} + | collectConstraints : {Trees (TypeConstraint ConstraintInfo)} + currentPhase : {Maybe Int} + currentPosition : {(Int, Int)} + metavarConstraints : {[(String,Tree (TypeConstraint ConstraintInfo))]} + | + ] + +SEM Core_TypingStrategy + | TypingStrategy + loc.allConstraintTrees = + listTree (reverse @typerule.constraints) : + Phase 999 @patchConstraints : + (map snd @statements.metavarConstraints) ++ + (reverse @statements.collectConstraints) + + loc.patchConstraints = + let parent = concat (M.elems (getAssumptions @lhs.infoTuple)) + children = concat (concatMap (M.elems . getAssumptions . snd) @lhs.metaVariableTable) + (ns, tps1) = unzip (parent \\ children) + (ss, tps2) = unzip @typeEnv + zipF t1 t2 = (t1 .==. @substitution |-> t2) infoF + infoF = emptyConstraintInfo + { location = "Typing Strategy (patch)" } + err = internalError "TS_Apply.ag" "n/a" "the type environments do not match" + in if (map show ns /= ss) then err else + zipWith zipF tps1 tps2 + + statements . collectConstraints = [] + . currentPhase = Nothing + . currentPosition = (@lhs.unique, 0) + . metavarConstraints = [ (s, getConstraintSet info) | (s, info) <- @lhs.metaVariableTable ] + . fromAttribute = let locals = map f (dom @substitution) + f i = (show i, MessageType (toTpScheme (lookupInt i @substitution))) + in toMessageBlock locals @lhs.infoTuple @lhs.metaVariableTable + +SEM Core_UserStatement + | Equal + lhs . currentPosition = (\(x, y) -> (x, y+1)) @lhs.currentPosition + . collectConstraints = case @lhs.currentPhase of + Just phase | phase /= 5 + -> Phase phase [ @newConstraint ] : @lhs.collectConstraints + _ -> unitTree @newConstraint : @lhs.collectConstraints + + | Pred + lhs . collectConstraints = unitTree @newConstraint : @lhs.collectConstraints + loc . newConstraint = + let cinfo = setTypeError (TypeError [] message [] []) + $ addProperty (ReductionErrorInfo thePred) + $ emptyConstraintInfo + thePred = Predicate @predClass (@lhs.substitution |-> @predType) + message = let f = MessageOneLiner . substituteAttributes @lhs.fromAttribute + in map f (lines @message) + in predicate thePred cinfo + + | MetaVariableConstraints + lhs . metavarConstraints = filter ((@name /=) . fst) @lhs.metavarConstraints + . collectConstraints = case lookup @name @lhs.metavarConstraints of + Just tree -> tree : @lhs.collectConstraints + Nothing -> internalError "TS_Apply.ag" "n/a" "unknown constraint set" + + | CorePhase + lhs . currentPhase = Just @phase + +SEM Core_UserStatement + | Equal + loc . newConstraint = + let cinfo = setTypeError (TypeError [] message [] []) + $ addProperty (uncurry IsUserConstraint @lhs.currentPosition) + $ inPhase emptyConstraintInfo + inPhase = case @lhs.currentPhase of + Just phase | phase /= 5 + -> addProperty (ConstraintPhaseNumber phase) + _ -> id + message = let f = MessageOneLiner . substituteAttributes @lhs.fromAttribute + in map f (lines @message) + in (@lhs.substitution |-> @leftType .==. @lhs.substitution |-> @rightType) cinfo + +ATTR Core_TypeRule [ | | constraints : {TypeConstraints ConstraintInfo} ] + +SEM Core_TypeRule + | TypeRule + lhs.constraints = + let conclusionSource = self (getLocalInfo @lhs.infoTuple) + conclusionType = getType @lhs.infoTuple + in [ (stp1 .==. conclusionType) + (addProperty FolkloreConstraint $ defaultConstraintInfo (conclusionSource, Nothing)) + | (_, tp1) <- @conclusion.judgements + , let stp1 = @lhs.substitution |-> tp1 + , stp1 /= conclusionType -- don't generate trivial constraints + ] ++ + [ (getType mvinfo .==. stp1) + (defaultConstraintInfo (conclusionSource, Just (self (getLocalInfo mvinfo)))) + | (s1, tp1) <- @premises.judgements + , (s2, mvinfo) <- @lhs.metaVariableTable + , s1 == s2 + , let stp1 = @lhs.substitution |-> tp1 + , getType mvinfo /= stp1 -- don't generate trivial constraints + ] + +{ +exactlyOnce :: Eq a => [a] -> [a] +exactlyOnce [] = [] +exactlyOnce (x:xs) | x `elem` xs = exactlyOnce . filter (/= x) $ xs + | otherwise = x : exactlyOnce xs +} + +ATTR Core_Judgements Core_Judgement Core_TypeRule [ | | judgements USE {++} {[]} : {[(String, Tp)]} ] + +SEM Core_Judgement + | Judgement + lhs . judgements = [(@expression, @type)] diff --git a/src/Helium/StaticAnalysis/Directives/TS_Apply.hs b/src/Helium/StaticAnalysis/Directives/TS_Apply.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_Apply.hs @@ -0,0 +1,702 @@ + + +-- UUAGC 0.9.42.2 (Helium/StaticAnalysis/Directives/TS_Apply.ag) +module Helium.StaticAnalysis.Directives.TS_Apply where + + +import Helium.Syntax.UHA_Syntax +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Data.List +import Helium.Utils.Utils (internalError) +import Helium.StaticAnalysis.Messages.Messages +import Helium.StaticAnalysis.Messages.TypeErrors +import Helium.ModuleSystem.ImportEnvironment +import Helium.StaticAnalysis.Inferencers.BindingGroupAnalysis (Assumptions, combine, noAssumptions) +import Helium.Parser.OperatorTable (OperatorTable) +import Helium.Parser.Parser (exp_) +import Helium.Parser.Lexer (strategiesLexer) +import Helium.Parser.ParseLibrary (runHParser) +import qualified Helium.Parser.ResolveOperators as ResolveOperators + +import qualified Data.Map as M +import Helium.StaticAnalysis.Directives.TS_Attributes +import Helium.StaticAnalysis.Directives.TS_CoreSyntax +import Top.Ordering.Tree + + +import Top.Types + +applyTypingStrategy :: Core_TypingStrategy -> MetaVariableInfo -> MetaVariableTable -> Int + -> (Assumptions, ConstraintSet, IO (), Int) +applyTypingStrategy strategy infoTuple metaVar unique = + let res = wrap_Core_TypingStrategy (sem_Core_TypingStrategy strategy) + Inh_Core_TypingStrategy { + infoTuple_Inh_Core_TypingStrategy = infoTuple, + metaVariableTable_Inh_Core_TypingStrategy = metaVar, + unique_Inh_Core_TypingStrategy = unique } + in (assumptions_Syn_Core_TypingStrategy res, constraintSet_Syn_Core_TypingStrategy res, debugIO_Syn_Core_TypingStrategy res, unique_Syn_Core_TypingStrategy res) + +matchInformation :: ImportEnvironment -> Core_TypingStrategy -> [(Expression, [String])] +matchInformation importEnvironment typingStrategy = + case typingStrategy of + TypingStrategy _ (TypeRule premises conclusion) _ -> + let Judgement exprstring _ = conclusion + expression = expressionParser (operatorTable importEnvironment) exprstring + metas = [ s | Judgement s _ <- premises ] + in [(expression, metas)] + _ -> [] + +expressionParser :: OperatorTable -> String -> Expression +expressionParser theOperatorTable string = + case strategiesLexer [] "TS_Apply" string of + Left _ -> intErr + Right (tokens, _) -> + case runHParser exp_ "TS_Apply" tokens True {- wait for EOF -} of + Left _ -> intErr + Right expression -> + ResolveOperators.expression theOperatorTable expression + where + intErr = internalError "TS_Apply.ag" "n/a" ("unparsable expression: "++show string) + + +exactlyOnce :: Eq a => [a] -> [a] +exactlyOnce [] = [] +exactlyOnce (x:xs) | x `elem` xs = exactlyOnce . filter (/= x) $ xs + | otherwise = x : exactlyOnce xs + + +type Core_TypingStrategies = [Core_TypingStrategy] +-- Core_Judgement ---------------------------------------------- +-- cata +sem_Core_Judgement :: Core_Judgement -> + T_Core_Judgement +sem_Core_Judgement (Judgement _expression _type) = + (sem_Core_Judgement_Judgement _expression _type) +-- semantic domain +type T_Core_Judgement = MetaVariableInfo -> + MetaVariableTable -> + MapSubstitution -> + ( ([Int]),([(String, Tp)])) +data Inh_Core_Judgement = Inh_Core_Judgement {infoTuple_Inh_Core_Judgement :: MetaVariableInfo,metaVariableTable_Inh_Core_Judgement :: MetaVariableTable,substitution_Inh_Core_Judgement :: MapSubstitution} +data Syn_Core_Judgement = Syn_Core_Judgement {ftv_Syn_Core_Judgement :: ([Int]),judgements_Syn_Core_Judgement :: ([(String, Tp)])} +wrap_Core_Judgement :: T_Core_Judgement -> + Inh_Core_Judgement -> + Syn_Core_Judgement +wrap_Core_Judgement sem (Inh_Core_Judgement _lhsIinfoTuple _lhsImetaVariableTable _lhsIsubstitution) = + (let ( _lhsOftv,_lhsOjudgements) = sem _lhsIinfoTuple _lhsImetaVariableTable _lhsIsubstitution + in (Syn_Core_Judgement _lhsOftv _lhsOjudgements)) +sem_Core_Judgement_Judgement :: String -> + Tp -> + T_Core_Judgement +sem_Core_Judgement_Judgement expression_ type_ = + (\ _lhsIinfoTuple + _lhsImetaVariableTable + _lhsIsubstitution -> + (let _lhsOftv :: ([Int]) + _lhsOjudgements :: ([(String, Tp)]) + _lhsOftv = + ftv type_ + _lhsOjudgements = + [(expression_, type_)] + in ( _lhsOftv,_lhsOjudgements))) +-- Core_Judgements --------------------------------------------- +-- cata +sem_Core_Judgements :: Core_Judgements -> + T_Core_Judgements +sem_Core_Judgements list = + (Prelude.foldr sem_Core_Judgements_Cons sem_Core_Judgements_Nil (Prelude.map sem_Core_Judgement list)) +-- semantic domain +type T_Core_Judgements = MetaVariableInfo -> + MetaVariableTable -> + MapSubstitution -> + ( ([Int]),([(String, Tp)])) +data Inh_Core_Judgements = Inh_Core_Judgements {infoTuple_Inh_Core_Judgements :: MetaVariableInfo,metaVariableTable_Inh_Core_Judgements :: MetaVariableTable,substitution_Inh_Core_Judgements :: MapSubstitution} +data Syn_Core_Judgements = Syn_Core_Judgements {ftv_Syn_Core_Judgements :: ([Int]),judgements_Syn_Core_Judgements :: ([(String, Tp)])} +wrap_Core_Judgements :: T_Core_Judgements -> + Inh_Core_Judgements -> + Syn_Core_Judgements +wrap_Core_Judgements sem (Inh_Core_Judgements _lhsIinfoTuple _lhsImetaVariableTable _lhsIsubstitution) = + (let ( _lhsOftv,_lhsOjudgements) = sem _lhsIinfoTuple _lhsImetaVariableTable _lhsIsubstitution + in (Syn_Core_Judgements _lhsOftv _lhsOjudgements)) +sem_Core_Judgements_Cons :: T_Core_Judgement -> + T_Core_Judgements -> + T_Core_Judgements +sem_Core_Judgements_Cons hd_ tl_ = + (\ _lhsIinfoTuple + _lhsImetaVariableTable + _lhsIsubstitution -> + (let _lhsOftv :: ([Int]) + _lhsOjudgements :: ([(String, Tp)]) + _hdOinfoTuple :: MetaVariableInfo + _hdOmetaVariableTable :: MetaVariableTable + _hdOsubstitution :: MapSubstitution + _tlOinfoTuple :: MetaVariableInfo + _tlOmetaVariableTable :: MetaVariableTable + _tlOsubstitution :: MapSubstitution + _hdIftv :: ([Int]) + _hdIjudgements :: ([(String, Tp)]) + _tlIftv :: ([Int]) + _tlIjudgements :: ([(String, Tp)]) + _lhsOftv = + _hdIftv `union` _tlIftv + _lhsOjudgements = + _hdIjudgements ++ _tlIjudgements + _hdOinfoTuple = + _lhsIinfoTuple + _hdOmetaVariableTable = + _lhsImetaVariableTable + _hdOsubstitution = + _lhsIsubstitution + _tlOinfoTuple = + _lhsIinfoTuple + _tlOmetaVariableTable = + _lhsImetaVariableTable + _tlOsubstitution = + _lhsIsubstitution + ( _hdIftv,_hdIjudgements) = + hd_ _hdOinfoTuple _hdOmetaVariableTable _hdOsubstitution + ( _tlIftv,_tlIjudgements) = + tl_ _tlOinfoTuple _tlOmetaVariableTable _tlOsubstitution + in ( _lhsOftv,_lhsOjudgements))) +sem_Core_Judgements_Nil :: T_Core_Judgements +sem_Core_Judgements_Nil = + (\ _lhsIinfoTuple + _lhsImetaVariableTable + _lhsIsubstitution -> + (let _lhsOftv :: ([Int]) + _lhsOjudgements :: ([(String, Tp)]) + _lhsOftv = + [] + _lhsOjudgements = + [] + in ( _lhsOftv,_lhsOjudgements))) +-- Core_TypeRule ----------------------------------------------- +-- cata +sem_Core_TypeRule :: Core_TypeRule -> + T_Core_TypeRule +sem_Core_TypeRule (TypeRule _premises _conclusion) = + (sem_Core_TypeRule_TypeRule (sem_Core_Judgements _premises) (sem_Core_Judgement _conclusion)) +-- semantic domain +type T_Core_TypeRule = MetaVariableInfo -> + MetaVariableTable -> + MapSubstitution -> + ( (TypeConstraints ConstraintInfo),([Int]),([(String, Tp)])) +data Inh_Core_TypeRule = Inh_Core_TypeRule {infoTuple_Inh_Core_TypeRule :: MetaVariableInfo,metaVariableTable_Inh_Core_TypeRule :: MetaVariableTable,substitution_Inh_Core_TypeRule :: MapSubstitution} +data Syn_Core_TypeRule = Syn_Core_TypeRule {constraints_Syn_Core_TypeRule :: (TypeConstraints ConstraintInfo),ftv_Syn_Core_TypeRule :: ([Int]),judgements_Syn_Core_TypeRule :: ([(String, Tp)])} +wrap_Core_TypeRule :: T_Core_TypeRule -> + Inh_Core_TypeRule -> + Syn_Core_TypeRule +wrap_Core_TypeRule sem (Inh_Core_TypeRule _lhsIinfoTuple _lhsImetaVariableTable _lhsIsubstitution) = + (let ( _lhsOconstraints,_lhsOftv,_lhsOjudgements) = sem _lhsIinfoTuple _lhsImetaVariableTable _lhsIsubstitution + in (Syn_Core_TypeRule _lhsOconstraints _lhsOftv _lhsOjudgements)) +sem_Core_TypeRule_TypeRule :: T_Core_Judgements -> + T_Core_Judgement -> + T_Core_TypeRule +sem_Core_TypeRule_TypeRule premises_ conclusion_ = + (\ _lhsIinfoTuple + _lhsImetaVariableTable + _lhsIsubstitution -> + (let _lhsOconstraints :: (TypeConstraints ConstraintInfo) + _lhsOftv :: ([Int]) + _lhsOjudgements :: ([(String, Tp)]) + _premisesOinfoTuple :: MetaVariableInfo + _premisesOmetaVariableTable :: MetaVariableTable + _premisesOsubstitution :: MapSubstitution + _conclusionOinfoTuple :: MetaVariableInfo + _conclusionOmetaVariableTable :: MetaVariableTable + _conclusionOsubstitution :: MapSubstitution + _premisesIftv :: ([Int]) + _premisesIjudgements :: ([(String, Tp)]) + _conclusionIftv :: ([Int]) + _conclusionIjudgements :: ([(String, Tp)]) + _lhsOconstraints = + let conclusionSource = self (getLocalInfo _lhsIinfoTuple) + conclusionType = getType _lhsIinfoTuple + in [ (stp1 .==. conclusionType) + (addProperty FolkloreConstraint $ defaultConstraintInfo (conclusionSource, Nothing)) + | (_, tp1) <- _conclusionIjudgements + , let stp1 = _lhsIsubstitution |-> tp1 + , stp1 /= conclusionType + ] ++ + [ (getType mvinfo .==. stp1) + (defaultConstraintInfo (conclusionSource, Just (self (getLocalInfo mvinfo)))) + | (s1, tp1) <- _premisesIjudgements + , (s2, mvinfo) <- _lhsImetaVariableTable + , s1 == s2 + , let stp1 = _lhsIsubstitution |-> tp1 + , getType mvinfo /= stp1 + ] + _lhsOftv = + _premisesIftv `union` _conclusionIftv + _lhsOjudgements = + _premisesIjudgements ++ _conclusionIjudgements + _premisesOinfoTuple = + _lhsIinfoTuple + _premisesOmetaVariableTable = + _lhsImetaVariableTable + _premisesOsubstitution = + _lhsIsubstitution + _conclusionOinfoTuple = + _lhsIinfoTuple + _conclusionOmetaVariableTable = + _lhsImetaVariableTable + _conclusionOsubstitution = + _lhsIsubstitution + ( _premisesIftv,_premisesIjudgements) = + premises_ _premisesOinfoTuple _premisesOmetaVariableTable _premisesOsubstitution + ( _conclusionIftv,_conclusionIjudgements) = + conclusion_ _conclusionOinfoTuple _conclusionOmetaVariableTable _conclusionOsubstitution + in ( _lhsOconstraints,_lhsOftv,_lhsOjudgements))) +-- Core_TypingStrategy ----------------------------------------- +-- cata +sem_Core_TypingStrategy :: Core_TypingStrategy -> + T_Core_TypingStrategy +sem_Core_TypingStrategy (Siblings _functions) = + (sem_Core_TypingStrategy_Siblings _functions) +sem_Core_TypingStrategy (TypingStrategy _typeEnv _typerule _statements) = + (sem_Core_TypingStrategy_TypingStrategy _typeEnv (sem_Core_TypeRule _typerule) (sem_Core_UserStatements _statements)) +-- semantic domain +type T_Core_TypingStrategy = MetaVariableInfo -> + MetaVariableTable -> + Int -> + ( Assumptions,ConstraintSet,(IO ()),Int) +data Inh_Core_TypingStrategy = Inh_Core_TypingStrategy {infoTuple_Inh_Core_TypingStrategy :: MetaVariableInfo,metaVariableTable_Inh_Core_TypingStrategy :: MetaVariableTable,unique_Inh_Core_TypingStrategy :: Int} +data Syn_Core_TypingStrategy = Syn_Core_TypingStrategy {assumptions_Syn_Core_TypingStrategy :: Assumptions,constraintSet_Syn_Core_TypingStrategy :: ConstraintSet,debugIO_Syn_Core_TypingStrategy :: (IO ()),unique_Syn_Core_TypingStrategy :: Int} +wrap_Core_TypingStrategy :: T_Core_TypingStrategy -> + Inh_Core_TypingStrategy -> + Syn_Core_TypingStrategy +wrap_Core_TypingStrategy sem (Inh_Core_TypingStrategy _lhsIinfoTuple _lhsImetaVariableTable _lhsIunique) = + (let ( _lhsOassumptions,_lhsOconstraintSet,_lhsOdebugIO,_lhsOunique) = sem _lhsIinfoTuple _lhsImetaVariableTable _lhsIunique + in (Syn_Core_TypingStrategy _lhsOassumptions _lhsOconstraintSet _lhsOdebugIO _lhsOunique)) +sem_Core_TypingStrategy_Siblings :: ([String]) -> + T_Core_TypingStrategy +sem_Core_TypingStrategy_Siblings functions_ = + (\ _lhsIinfoTuple + _lhsImetaVariableTable + _lhsIunique -> + (let _lhsOassumptions :: Assumptions + _lhsOconstraintSet :: ConstraintSet + _lhsOdebugIO :: (IO ()) + _lhsOunique :: Int + _lhsOassumptions = + noAssumptions + _lhsOconstraintSet = + emptyTree + _lhsOdebugIO = + return () + _lhsOunique = + _lhsIunique + in ( _lhsOassumptions,_lhsOconstraintSet,_lhsOdebugIO,_lhsOunique))) +sem_Core_TypingStrategy_TypingStrategy :: ([(String, Tp)]) -> + T_Core_TypeRule -> + T_Core_UserStatements -> + T_Core_TypingStrategy +sem_Core_TypingStrategy_TypingStrategy typeEnv_ typerule_ statements_ = + (\ _lhsIinfoTuple + _lhsImetaVariableTable + _lhsIunique -> + (let _lhsOassumptions :: Assumptions + _lhsOconstraintSet :: ConstraintSet + _lhsOunique :: Int + _lhsOdebugIO :: (IO ()) + _statementsOcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _statementsOcurrentPhase :: (Maybe Int) + _statementsOcurrentPosition :: ((Int, Int)) + _statementsOmetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _statementsOfromAttribute :: (Attribute -> MessageBlock) + _typeruleOinfoTuple :: MetaVariableInfo + _typeruleOmetaVariableTable :: MetaVariableTable + _typeruleOsubstitution :: MapSubstitution + _statementsOinfoTuple :: MetaVariableInfo + _statementsOmetaVariableTable :: MetaVariableTable + _statementsOsubstitution :: MapSubstitution + _typeruleIconstraints :: (TypeConstraints ConstraintInfo) + _typeruleIftv :: ([Int]) + _typeruleIjudgements :: ([(String, Tp)]) + _statementsIcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _statementsIcurrentPhase :: (Maybe Int) + _statementsIcurrentPosition :: ((Int, Int)) + _statementsIftv :: ([Int]) + _statementsImetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _lhsOassumptions = + foldr combine noAssumptions (map (getAssumptions . snd) _lhsImetaVariableTable) + _lhsOconstraintSet = + Node _allConstraintTrees + _lhsOunique = + length _normalTV + _lhsIunique + _lhsOdebugIO = + putStrLn "applying typing strategy" + _substitution = + listToSubstitution (_standardSubst ++ _specialSubst) + _allTV = + _typeruleIftv `union` _statementsIftv `union` ftv (map snd typeEnv_) + _specialTV = + concat . exactlyOnce . map ftv . filter isTVar . map snd $ _typeruleIjudgements + _normalTV = + _allTV \\ _specialTV + _standardSubst = + zip _normalTV (map TVar [_lhsIunique..]) + _specialSubst = + let conclusionVar = case snd (last _typeruleIjudgements) of + TVar i -> Just i + _ -> Nothing + find' i | Just i == conclusionVar = [ (i, getType _lhsIinfoTuple) ] + | otherwise = [ (i, getType infoTuple) + | (s1, TVar j) <- _typeruleIjudgements + , i == j + , (s2,infoTuple) <- _lhsImetaVariableTable + , s1 == s2 + ] + in concatMap find' _specialTV + _allConstraintTrees = + listTree (reverse _typeruleIconstraints) : + Phase 999 _patchConstraints : + (map snd _statementsImetavarConstraints) ++ + (reverse _statementsIcollectConstraints) + _patchConstraints = + let parent = concat (M.elems (getAssumptions _lhsIinfoTuple)) + children = concat (concatMap (M.elems . getAssumptions . snd) _lhsImetaVariableTable) + (ns, tps1) = unzip (parent \\ children) + (ss, tps2) = unzip typeEnv_ + zipF t1 t2 = (t1 .==. _substitution |-> t2) infoF + infoF = emptyConstraintInfo + { location = "Typing Strategy (patch)" } + err = internalError "TS_Apply.ag" "n/a" "the type environments do not match" + in if (map show ns /= ss) then err else + zipWith zipF tps1 tps2 + _statementsOcollectConstraints = + [] + _statementsOcurrentPhase = + Nothing + _statementsOcurrentPosition = + (_lhsIunique, 0) + _statementsOmetavarConstraints = + [ (s, getConstraintSet info) | (s, info) <- _lhsImetaVariableTable ] + _statementsOfromAttribute = + let locals = map f (dom _substitution) + f i = (show i, MessageType (toTpScheme (lookupInt i _substitution))) + in toMessageBlock locals _lhsIinfoTuple _lhsImetaVariableTable + _typeruleOinfoTuple = + _lhsIinfoTuple + _typeruleOmetaVariableTable = + _lhsImetaVariableTable + _typeruleOsubstitution = + _substitution + _statementsOinfoTuple = + _lhsIinfoTuple + _statementsOmetaVariableTable = + _lhsImetaVariableTable + _statementsOsubstitution = + _substitution + ( _typeruleIconstraints,_typeruleIftv,_typeruleIjudgements) = + typerule_ _typeruleOinfoTuple _typeruleOmetaVariableTable _typeruleOsubstitution + ( _statementsIcollectConstraints,_statementsIcurrentPhase,_statementsIcurrentPosition,_statementsIftv,_statementsImetavarConstraints) = + statements_ _statementsOcollectConstraints _statementsOcurrentPhase _statementsOcurrentPosition _statementsOfromAttribute _statementsOinfoTuple _statementsOmetaVariableTable _statementsOmetavarConstraints _statementsOsubstitution + in ( _lhsOassumptions,_lhsOconstraintSet,_lhsOdebugIO,_lhsOunique))) +-- Core_UserStatement ------------------------------------------ +-- cata +sem_Core_UserStatement :: Core_UserStatement -> + T_Core_UserStatement +sem_Core_UserStatement (Equal _leftType _rightType _message) = + (sem_Core_UserStatement_Equal _leftType _rightType _message) +sem_Core_UserStatement (Pred _predClass _predType _message) = + (sem_Core_UserStatement_Pred _predClass _predType _message) +sem_Core_UserStatement (MetaVariableConstraints _name) = + (sem_Core_UserStatement_MetaVariableConstraints _name) +sem_Core_UserStatement (CorePhase _phase) = + (sem_Core_UserStatement_CorePhase _phase) +-- semantic domain +type T_Core_UserStatement = (Trees (TypeConstraint ConstraintInfo)) -> + (Maybe Int) -> + ((Int, Int)) -> + (Attribute -> MessageBlock) -> + MetaVariableInfo -> + MetaVariableTable -> + ([(String,Tree (TypeConstraint ConstraintInfo))]) -> + MapSubstitution -> + ( (Trees (TypeConstraint ConstraintInfo)),(Maybe Int),((Int, Int)),([Int]),([(String,Tree (TypeConstraint ConstraintInfo))])) +data Inh_Core_UserStatement = Inh_Core_UserStatement {collectConstraints_Inh_Core_UserStatement :: (Trees (TypeConstraint ConstraintInfo)),currentPhase_Inh_Core_UserStatement :: (Maybe Int),currentPosition_Inh_Core_UserStatement :: ((Int, Int)),fromAttribute_Inh_Core_UserStatement :: (Attribute -> MessageBlock),infoTuple_Inh_Core_UserStatement :: MetaVariableInfo,metaVariableTable_Inh_Core_UserStatement :: MetaVariableTable,metavarConstraints_Inh_Core_UserStatement :: ([(String,Tree (TypeConstraint ConstraintInfo))]),substitution_Inh_Core_UserStatement :: MapSubstitution} +data Syn_Core_UserStatement = Syn_Core_UserStatement {collectConstraints_Syn_Core_UserStatement :: (Trees (TypeConstraint ConstraintInfo)),currentPhase_Syn_Core_UserStatement :: (Maybe Int),currentPosition_Syn_Core_UserStatement :: ((Int, Int)),ftv_Syn_Core_UserStatement :: ([Int]),metavarConstraints_Syn_Core_UserStatement :: ([(String,Tree (TypeConstraint ConstraintInfo))])} +wrap_Core_UserStatement :: T_Core_UserStatement -> + Inh_Core_UserStatement -> + Syn_Core_UserStatement +wrap_Core_UserStatement sem (Inh_Core_UserStatement _lhsIcollectConstraints _lhsIcurrentPhase _lhsIcurrentPosition _lhsIfromAttribute _lhsIinfoTuple _lhsImetaVariableTable _lhsImetavarConstraints _lhsIsubstitution) = + (let ( _lhsOcollectConstraints,_lhsOcurrentPhase,_lhsOcurrentPosition,_lhsOftv,_lhsOmetavarConstraints) = sem _lhsIcollectConstraints _lhsIcurrentPhase _lhsIcurrentPosition _lhsIfromAttribute _lhsIinfoTuple _lhsImetaVariableTable _lhsImetavarConstraints _lhsIsubstitution + in (Syn_Core_UserStatement _lhsOcollectConstraints _lhsOcurrentPhase _lhsOcurrentPosition _lhsOftv _lhsOmetavarConstraints)) +sem_Core_UserStatement_Equal :: Tp -> + Tp -> + String -> + T_Core_UserStatement +sem_Core_UserStatement_Equal leftType_ rightType_ message_ = + (\ _lhsIcollectConstraints + _lhsIcurrentPhase + _lhsIcurrentPosition + _lhsIfromAttribute + _lhsIinfoTuple + _lhsImetaVariableTable + _lhsImetavarConstraints + _lhsIsubstitution -> + (let _lhsOftv :: ([Int]) + _lhsOcurrentPosition :: ((Int, Int)) + _lhsOcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _lhsOcurrentPhase :: (Maybe Int) + _lhsOmetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _lhsOftv = + ftv [leftType_, rightType_] + _lhsOcurrentPosition = + (\(x, y) -> (x, y+1)) _lhsIcurrentPosition + _lhsOcollectConstraints = + case _lhsIcurrentPhase of + Just phase | phase /= 5 + -> Phase phase [ _newConstraint ] : _lhsIcollectConstraints + _ -> unitTree _newConstraint : _lhsIcollectConstraints + _newConstraint = + let cinfo = setTypeError (TypeError [] message [] []) + $ addProperty (uncurry IsUserConstraint _lhsIcurrentPosition) + $ inPhase emptyConstraintInfo + inPhase = case _lhsIcurrentPhase of + Just phase | phase /= 5 + -> addProperty (ConstraintPhaseNumber phase) + _ -> id + message = let f = MessageOneLiner . substituteAttributes _lhsIfromAttribute + in map f (lines message_) + in (_lhsIsubstitution |-> leftType_ .==. _lhsIsubstitution |-> rightType_) cinfo + _lhsOcurrentPhase = + _lhsIcurrentPhase + _lhsOmetavarConstraints = + _lhsImetavarConstraints + in ( _lhsOcollectConstraints,_lhsOcurrentPhase,_lhsOcurrentPosition,_lhsOftv,_lhsOmetavarConstraints))) +sem_Core_UserStatement_Pred :: String -> + Tp -> + String -> + T_Core_UserStatement +sem_Core_UserStatement_Pred predClass_ predType_ message_ = + (\ _lhsIcollectConstraints + _lhsIcurrentPhase + _lhsIcurrentPosition + _lhsIfromAttribute + _lhsIinfoTuple + _lhsImetaVariableTable + _lhsImetavarConstraints + _lhsIsubstitution -> + (let _lhsOcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _lhsOftv :: ([Int]) + _lhsOcurrentPhase :: (Maybe Int) + _lhsOcurrentPosition :: ((Int, Int)) + _lhsOmetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _lhsOcollectConstraints = + unitTree _newConstraint : _lhsIcollectConstraints + _newConstraint = + let cinfo = setTypeError (TypeError [] message [] []) + $ addProperty (ReductionErrorInfo thePred) + $ emptyConstraintInfo + thePred = Predicate predClass_ (_lhsIsubstitution |-> predType_) + message = let f = MessageOneLiner . substituteAttributes _lhsIfromAttribute + in map f (lines message_) + in predicate thePred cinfo + _lhsOftv = + [] + _lhsOcurrentPhase = + _lhsIcurrentPhase + _lhsOcurrentPosition = + _lhsIcurrentPosition + _lhsOmetavarConstraints = + _lhsImetavarConstraints + in ( _lhsOcollectConstraints,_lhsOcurrentPhase,_lhsOcurrentPosition,_lhsOftv,_lhsOmetavarConstraints))) +sem_Core_UserStatement_MetaVariableConstraints :: String -> + T_Core_UserStatement +sem_Core_UserStatement_MetaVariableConstraints name_ = + (\ _lhsIcollectConstraints + _lhsIcurrentPhase + _lhsIcurrentPosition + _lhsIfromAttribute + _lhsIinfoTuple + _lhsImetaVariableTable + _lhsImetavarConstraints + _lhsIsubstitution -> + (let _lhsOmetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _lhsOcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _lhsOftv :: ([Int]) + _lhsOcurrentPhase :: (Maybe Int) + _lhsOcurrentPosition :: ((Int, Int)) + _lhsOmetavarConstraints = + filter ((name_ /=) . fst) _lhsImetavarConstraints + _lhsOcollectConstraints = + case lookup name_ _lhsImetavarConstraints of + Just tree -> tree : _lhsIcollectConstraints + Nothing -> internalError "TS_Apply.ag" "n/a" "unknown constraint set" + _lhsOftv = + [] + _lhsOcurrentPhase = + _lhsIcurrentPhase + _lhsOcurrentPosition = + _lhsIcurrentPosition + in ( _lhsOcollectConstraints,_lhsOcurrentPhase,_lhsOcurrentPosition,_lhsOftv,_lhsOmetavarConstraints))) +sem_Core_UserStatement_CorePhase :: Int -> + T_Core_UserStatement +sem_Core_UserStatement_CorePhase phase_ = + (\ _lhsIcollectConstraints + _lhsIcurrentPhase + _lhsIcurrentPosition + _lhsIfromAttribute + _lhsIinfoTuple + _lhsImetaVariableTable + _lhsImetavarConstraints + _lhsIsubstitution -> + (let _lhsOcurrentPhase :: (Maybe Int) + _lhsOftv :: ([Int]) + _lhsOcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _lhsOcurrentPosition :: ((Int, Int)) + _lhsOmetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _lhsOcurrentPhase = + Just phase_ + _lhsOftv = + [] + _lhsOcollectConstraints = + _lhsIcollectConstraints + _lhsOcurrentPosition = + _lhsIcurrentPosition + _lhsOmetavarConstraints = + _lhsImetavarConstraints + in ( _lhsOcollectConstraints,_lhsOcurrentPhase,_lhsOcurrentPosition,_lhsOftv,_lhsOmetavarConstraints))) +-- Core_UserStatements ----------------------------------------- +-- cata +sem_Core_UserStatements :: Core_UserStatements -> + T_Core_UserStatements +sem_Core_UserStatements list = + (Prelude.foldr sem_Core_UserStatements_Cons sem_Core_UserStatements_Nil (Prelude.map sem_Core_UserStatement list)) +-- semantic domain +type T_Core_UserStatements = (Trees (TypeConstraint ConstraintInfo)) -> + (Maybe Int) -> + ((Int, Int)) -> + (Attribute -> MessageBlock) -> + MetaVariableInfo -> + MetaVariableTable -> + ([(String,Tree (TypeConstraint ConstraintInfo))]) -> + MapSubstitution -> + ( (Trees (TypeConstraint ConstraintInfo)),(Maybe Int),((Int, Int)),([Int]),([(String,Tree (TypeConstraint ConstraintInfo))])) +data Inh_Core_UserStatements = Inh_Core_UserStatements {collectConstraints_Inh_Core_UserStatements :: (Trees (TypeConstraint ConstraintInfo)),currentPhase_Inh_Core_UserStatements :: (Maybe Int),currentPosition_Inh_Core_UserStatements :: ((Int, Int)),fromAttribute_Inh_Core_UserStatements :: (Attribute -> MessageBlock),infoTuple_Inh_Core_UserStatements :: MetaVariableInfo,metaVariableTable_Inh_Core_UserStatements :: MetaVariableTable,metavarConstraints_Inh_Core_UserStatements :: ([(String,Tree (TypeConstraint ConstraintInfo))]),substitution_Inh_Core_UserStatements :: MapSubstitution} +data Syn_Core_UserStatements = Syn_Core_UserStatements {collectConstraints_Syn_Core_UserStatements :: (Trees (TypeConstraint ConstraintInfo)),currentPhase_Syn_Core_UserStatements :: (Maybe Int),currentPosition_Syn_Core_UserStatements :: ((Int, Int)),ftv_Syn_Core_UserStatements :: ([Int]),metavarConstraints_Syn_Core_UserStatements :: ([(String,Tree (TypeConstraint ConstraintInfo))])} +wrap_Core_UserStatements :: T_Core_UserStatements -> + Inh_Core_UserStatements -> + Syn_Core_UserStatements +wrap_Core_UserStatements sem (Inh_Core_UserStatements _lhsIcollectConstraints _lhsIcurrentPhase _lhsIcurrentPosition _lhsIfromAttribute _lhsIinfoTuple _lhsImetaVariableTable _lhsImetavarConstraints _lhsIsubstitution) = + (let ( _lhsOcollectConstraints,_lhsOcurrentPhase,_lhsOcurrentPosition,_lhsOftv,_lhsOmetavarConstraints) = sem _lhsIcollectConstraints _lhsIcurrentPhase _lhsIcurrentPosition _lhsIfromAttribute _lhsIinfoTuple _lhsImetaVariableTable _lhsImetavarConstraints _lhsIsubstitution + in (Syn_Core_UserStatements _lhsOcollectConstraints _lhsOcurrentPhase _lhsOcurrentPosition _lhsOftv _lhsOmetavarConstraints)) +sem_Core_UserStatements_Cons :: T_Core_UserStatement -> + T_Core_UserStatements -> + T_Core_UserStatements +sem_Core_UserStatements_Cons hd_ tl_ = + (\ _lhsIcollectConstraints + _lhsIcurrentPhase + _lhsIcurrentPosition + _lhsIfromAttribute + _lhsIinfoTuple + _lhsImetaVariableTable + _lhsImetavarConstraints + _lhsIsubstitution -> + (let _lhsOftv :: ([Int]) + _lhsOcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _lhsOcurrentPhase :: (Maybe Int) + _lhsOcurrentPosition :: ((Int, Int)) + _lhsOmetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _hdOcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _hdOcurrentPhase :: (Maybe Int) + _hdOcurrentPosition :: ((Int, Int)) + _hdOfromAttribute :: (Attribute -> MessageBlock) + _hdOinfoTuple :: MetaVariableInfo + _hdOmetaVariableTable :: MetaVariableTable + _hdOmetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _hdOsubstitution :: MapSubstitution + _tlOcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _tlOcurrentPhase :: (Maybe Int) + _tlOcurrentPosition :: ((Int, Int)) + _tlOfromAttribute :: (Attribute -> MessageBlock) + _tlOinfoTuple :: MetaVariableInfo + _tlOmetaVariableTable :: MetaVariableTable + _tlOmetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _tlOsubstitution :: MapSubstitution + _hdIcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _hdIcurrentPhase :: (Maybe Int) + _hdIcurrentPosition :: ((Int, Int)) + _hdIftv :: ([Int]) + _hdImetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _tlIcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _tlIcurrentPhase :: (Maybe Int) + _tlIcurrentPosition :: ((Int, Int)) + _tlIftv :: ([Int]) + _tlImetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _lhsOftv = + _hdIftv `union` _tlIftv + _lhsOcollectConstraints = + _tlIcollectConstraints + _lhsOcurrentPhase = + _tlIcurrentPhase + _lhsOcurrentPosition = + _tlIcurrentPosition + _lhsOmetavarConstraints = + _tlImetavarConstraints + _hdOcollectConstraints = + _lhsIcollectConstraints + _hdOcurrentPhase = + _lhsIcurrentPhase + _hdOcurrentPosition = + _lhsIcurrentPosition + _hdOfromAttribute = + _lhsIfromAttribute + _hdOinfoTuple = + _lhsIinfoTuple + _hdOmetaVariableTable = + _lhsImetaVariableTable + _hdOmetavarConstraints = + _lhsImetavarConstraints + _hdOsubstitution = + _lhsIsubstitution + _tlOcollectConstraints = + _hdIcollectConstraints + _tlOcurrentPhase = + _hdIcurrentPhase + _tlOcurrentPosition = + _hdIcurrentPosition + _tlOfromAttribute = + _lhsIfromAttribute + _tlOinfoTuple = + _lhsIinfoTuple + _tlOmetaVariableTable = + _lhsImetaVariableTable + _tlOmetavarConstraints = + _hdImetavarConstraints + _tlOsubstitution = + _lhsIsubstitution + ( _hdIcollectConstraints,_hdIcurrentPhase,_hdIcurrentPosition,_hdIftv,_hdImetavarConstraints) = + hd_ _hdOcollectConstraints _hdOcurrentPhase _hdOcurrentPosition _hdOfromAttribute _hdOinfoTuple _hdOmetaVariableTable _hdOmetavarConstraints _hdOsubstitution + ( _tlIcollectConstraints,_tlIcurrentPhase,_tlIcurrentPosition,_tlIftv,_tlImetavarConstraints) = + tl_ _tlOcollectConstraints _tlOcurrentPhase _tlOcurrentPosition _tlOfromAttribute _tlOinfoTuple _tlOmetaVariableTable _tlOmetavarConstraints _tlOsubstitution + in ( _lhsOcollectConstraints,_lhsOcurrentPhase,_lhsOcurrentPosition,_lhsOftv,_lhsOmetavarConstraints))) +sem_Core_UserStatements_Nil :: T_Core_UserStatements +sem_Core_UserStatements_Nil = + (\ _lhsIcollectConstraints + _lhsIcurrentPhase + _lhsIcurrentPosition + _lhsIfromAttribute + _lhsIinfoTuple + _lhsImetaVariableTable + _lhsImetavarConstraints + _lhsIsubstitution -> + (let _lhsOftv :: ([Int]) + _lhsOcollectConstraints :: (Trees (TypeConstraint ConstraintInfo)) + _lhsOcurrentPhase :: (Maybe Int) + _lhsOcurrentPosition :: ((Int, Int)) + _lhsOmetavarConstraints :: ([(String,Tree (TypeConstraint ConstraintInfo))]) + _lhsOftv = + [] + _lhsOcollectConstraints = + _lhsIcollectConstraints + _lhsOcurrentPhase = + _lhsIcurrentPhase + _lhsOcurrentPosition = + _lhsIcurrentPosition + _lhsOmetavarConstraints = + _lhsImetavarConstraints + in ( _lhsOcollectConstraints,_lhsOcurrentPhase,_lhsOcurrentPosition,_lhsOftv,_lhsOmetavarConstraints))) diff --git a/src/Helium/StaticAnalysis/Directives/TS_Attributes.hs b/src/Helium/StaticAnalysis/Directives/TS_Attributes.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_Attributes.hs @@ -0,0 +1,114 @@ +{-| Module : TS_Attributes + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Substitute the attributes in a user defined error message. + + (directives based on "Scripting the Type Inference Process", ICFP 2003) +-} + +module Helium.StaticAnalysis.Directives.TS_Attributes where + +import Helium.StaticAnalysis.Inferencers.BindingGroupAnalysis (Assumptions) +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo (ConstraintSet, LocalInfo, assignedType, self) +import Helium.StaticAnalysis.Messages.Messages (MessageBlock(..)) +import Top.Types (Tp, toTpScheme) +import Helium.Utils.OneLiner (OneLineTree) +import Helium.Syntax.UHA_Syntax (Range) +import Helium.StaticAnalysis.Miscellaneous.UHA_Source (rangeOfSource, oneLinerSource) +import Helium.Utils.Utils (internalError) +import Data.Char (isAlphaNum) + +type MetaVariableTable = [(String, MetaVariableInfo)] + +data MetaVariableInfo = MetaVarInfo + { getConstraintSet :: ConstraintSet + , getAssumptions :: Assumptions + , getLocalInfo :: LocalInfo + } + +metaVarInfo :: ConstraintSet -> Assumptions -> LocalInfo -> MetaVariableInfo +metaVarInfo = MetaVarInfo + +getMaybeType :: MetaVariableInfo -> Maybe Tp +getMaybeType = assignedType . getLocalInfo + +getType :: MetaVariableInfo -> Tp +getType = + let err = internalError "TS_MetaInfo" "getType" "no type was assigned at the current local info" + in maybe err id . getMaybeType + +getRange :: MetaVariableInfo -> Range +getRange = rangeOfSource . self . getLocalInfo + +getOneLineTree :: MetaVariableInfo -> OneLineTree +getOneLineTree = oneLinerSource . self . getLocalInfo + +-- attributes + +type AttributeTable = [(String, MetaVariableInfo -> MessageBlock)] -- ????? + +data Attribute = LocalAttribute String + | MetaVarAttribute String String + deriving Eq + +instance Show Attribute where + show attribute = + case attribute of + LocalAttribute s -> "@" ++ s ++ "@" + MetaVarAttribute mv s -> "@" ++ mv ++ "." ++ s ++ "@" + +parseWithAttributes :: String -> [Either Attribute String] +parseWithAttributes [] = [] +parseWithAttributes xs = + let (begin, rest) = span (/= '@') xs + in case rest of + [] -> [Right begin] + '@' : rest1 -> + let (variableName, as) = span isAlphaNum rest1 + in case as of + '@' : rest2 -> Right begin : Left (LocalAttribute variableName) : parseWithAttributes rest2 + '.' : rest2 -> + let (fieldName, bs) = span isAlphaNum rest2 + in case bs of + '@' : rest3 -> Right begin : Left (MetaVarAttribute variableName fieldName) : parseWithAttributes rest3 + _ -> Right (begin++"@"++variableName++"."++fieldName) : parseWithAttributes as + _ -> Right (begin++"@"++variableName) : parseWithAttributes as + _ -> error "error in StaticAnalysis.Directives.parseWithAttributes" + +findAttributes :: String -> [Attribute] +findAttributes s = [ a | Left a <- parseWithAttributes s ] + +changeAttributes :: (Attribute -> Attribute) -> String -> String +changeAttributes f = concatMap (either (show . f) id) . parseWithAttributes + +substituteAttributes :: (Attribute -> MessageBlock) -> String -> MessageBlock +substituteAttributes f = MessageCompose . map (either f MessageString) . parseWithAttributes + +toMessageBlock :: [(String, MessageBlock)] -> MetaVariableInfo -> MetaVariableTable -> Attribute -> MessageBlock +toMessageBlock locals metaInfo table attribute = + case attribute of + LocalAttribute s -> + let err = internalError "TS_Attributes.hs" "toMessageBlock" ("unknown local attribute " ++ s) + in maybe err id (lookup s locals) + MetaVarAttribute s f + | s == "expr" -> findAttributeField f s metaInfo + | otherwise -> + let err = internalError "TS_Attributes.hs" "toMessageBlock" ("unknown combination " ++ s ++ "." ++ f) + in maybe err (findAttributeField f s) (lookup s table) + +-- Added parameter s for diagnostic reasons, and renamed the old s to f. +findAttributeField :: String -> String -> MetaVariableInfo -> MessageBlock +findAttributeField f s = + let err = internalError "TS_Attributes.hs" "toMessageBlock" ("unknown attribute field " ++ f ++ " of metavariable " ++ s) + in maybe err id (lookup f attributeFieldTable) + +attributeFieldTable :: [(String, MetaVariableInfo -> MessageBlock)] +attributeFieldTable = + [ ("type" , MessageType . toTpScheme . getType) + , ("pp" , MessageOneLineTree . getOneLineTree) + , ("range", MessageRange . getRange) + ] diff --git a/src/Helium/StaticAnalysis/Directives/TS_Collect.ag b/src/Helium/StaticAnalysis/Directives/TS_Collect.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_Collect.ag @@ -0,0 +1,99 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Collects information +-- +-- (directives based on "Scripting the Type Inference Process", ICFP 2003) +----------------------------------------------------------------------------- +imports { +import Helium.StaticAnalysis.Inferencers.ExpressionTypeInferencer (expressionTypeInferencer) +import qualified Data.Map as M +} + +-- Collect all type variables + +ATTR UserStatement UserStatements TypeRule Judgement SimpleJudgement SimpleJudgements + Type Types [ | | typevariables USE { ++ } { [] } : Names ] + +SEM Type + | Variable lhs . typevariables = [ @name.self ] + +SEM TypingStrategy + | TypingStrategy + loc . uniqueTypevariables = nub (@typerule.typevariables ++ @statements.typevariables) + +ATTR UserStatement UserStatements TypeRule Judgement SimpleJudgement SimpleJudgements + [ nameMap : {[(Name,Tp)]} | | ] + +-- Construct type constraints from the constraint-set + +ATTR UserStatement UserStatements [ | userConstraints : {TypeConstraints ConstraintInfo} + userPredicates : Predicates | ] + +SEM TypingStrategy + | TypingStrategy + statements . userConstraints = [] + . userPredicates = [] + +SEM UserStatement + | Equal + lhs . userConstraints = @newConstraint : @lhs.userConstraints + loc . newConstraint = (makeTpFromType @lhs.nameMap @leftType.self .==. makeTpFromType @lhs.nameMap @rightType.self) @lhs.standardConstraintInfo + | Pred + lhs . userPredicates = @newPredicate : @lhs.userPredicates + loc . newPredicate = Predicate (show @predClass.self) (makeTpFromType @lhs.nameMap @predType.self) + +-- Collect judgements in typerule + +ATTR SimpleJudgement SimpleJudgements TypeRule [ | simpleJudgements:{[(String,Tp)]} | ] + +SEM TypingStrategy + | TypingStrategy + typerule . simpleJudgements = [] + +SEM SimpleJudgement + | SimpleJudgement + lhs . simpleJudgements = @newJudgement : @lhs.simpleJudgements + loc . newJudgement = (show @name.self, makeTpFromType @lhs.nameMap @type.self) + +ATTR Judgement TypeRule [ | | conclusionType : Tp ] + +SEM Judgement + | Judgement lhs . conclusionType = makeTpFromType @lhs.nameMap @type.self + +-- Collecting MetaVariableConstraints + +ATTR UserStatements UserStatement [ | metaVariableConstraintNames : Names | ] + +SEM TypingStrategy + | TypingStrategy + statements . metaVariableConstraintNames = [] + +SEM UserStatement + | MetaVariableConstraints + lhs . metaVariableConstraintNames = @name.self : @lhs.metaVariableConstraintNames + +SEM TypingStrategy + | TypingStrategy + loc . allMetaVariables = map fst @typerule.simpleJudgements + . constraintsNotExplicit = filter (`notElem` (map show @statements.metaVariableConstraintNames)) @allMetaVariables + +ATTR UserStatements UserStatement [ standardConstraintInfo : ConstraintInfo + attributeTable : {[((String, Maybe String), MessageBlock)]} | | ] + +SEM TypingStrategy + | TypingStrategy + loc . standardConstraintInfo = standardConstraintInfo + . attributeTable = [] + +-- + +ATTR TypeRule [ | | conclusionExpression:Expression ] +ATTR Judgement [ | | theExpression:Expression ] + +SEM TypeRule | TypeRule lhs . conclusionExpression = @conclusion.theExpression +SEM Judgement | Judgement lhs . theExpression = @expression.self diff --git a/src/Helium/StaticAnalysis/Directives/TS_Compile.hs b/src/Helium/StaticAnalysis/Directives/TS_Compile.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_Compile.hs @@ -0,0 +1,74 @@ +{-| Module : TS_Compile + License : GPL + + Maintainer : bastiaan@cs.uu.nl + Stability : experimental + Portability : portable + + Compile a .type file. + + (directives based on "Scripting the Type Inference Process", ICFP 2003) +-} + +module Helium.StaticAnalysis.Directives.TS_Compile where + +import Helium.StaticAnalysis.Directives.TS_CoreSyntax +import Helium.ModuleSystem.ImportEnvironment +import Helium.StaticAnalysis.Directives.TS_ToCore (typingStrategyToCore) +import System.Exit (exitWith, ExitCode(..) ) +import System.Directory (doesFileExist) +import Helium.StaticAnalysis.Directives.TS_Parser (parseTypingStrategies) +import Helium.Parser.Lexer (strategiesLexer) +import Helium.StaticAnalysis.Directives.TS_Analyse (analyseTypingStrategies) +import Helium.StaticAnalysis.Messages.HeliumMessages (sortAndShowMessages) +import Control.Monad (unless, when) +import qualified Helium.Main.Args as Args +import Helium.Parser.ParseMessage () +import Helium.CodeGeneration.CoreUtils +import Lvm.Core.Expr + +readTypingStrategiesFromFile :: [Args.Option] -> String -> ImportEnvironment -> + IO (Core_TypingStrategies, [CoreDecl]) +readTypingStrategiesFromFile options filename importEnvironment = + + doesFileExist filename >>= + + \exists -> if not exists then return ([], []) else + + do fileContent <- readFile filename + case strategiesLexer options filename fileContent of + Left lexError -> do + putStrLn "Parse error in typing strategy: " + putStr . sortAndShowMessages $ [lexError] + exitWith (ExitFailure 1) + Right (tokens, _) -> + case parseTypingStrategies (operatorTable importEnvironment) filename tokens of + Left parseError -> do + putStrLn "Parse error in typing strategy: " + putStr . sortAndShowMessages $ [parseError] + exitWith (ExitFailure 1) + Right strategies -> + + do let (errors, warnings) = analyseTypingStrategies strategies importEnvironment + + unless (null errors) $ + do putStr . sortAndShowMessages $ errors + exitWith (ExitFailure 1) + + unless (Args.NoWarnings `elem` options || null warnings) $ + do putStrLn "\nWarnings in typing strategies:" + putStrLn . sortAndShowMessages $ warnings + + let number = length strategies + when (Args.Verbose `elem` options && number > 0) $ + putStrLn (" (" ++ + (if number == 1 + then "1 strategy is included)" + else show number ++ " strategies are included)")) + + let coreTypingStrategies = map (typingStrategyToCore importEnvironment) strategies + when (Args.DumpTypeDebug `elem` options) $ + do putStrLn "Core typing strategies:" + mapM_ print coreTypingStrategies + + return ( coreTypingStrategies, [ customStrategy (show coreTypingStrategies) ] ) diff --git a/src/Helium/StaticAnalysis/Directives/TS_CoreSyntax.ag b/src/Helium/StaticAnalysis/Directives/TS_CoreSyntax.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_CoreSyntax.ag @@ -0,0 +1,56 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- A datatype to represent the directives. +-- +-- (directives based on "Scripting the Type Inference Process", ICFP 2003) +----------------------------------------------------------------------------- + +imports { +import Top.Types +} + +DERIVING Core_TypingStrategy Core_Judgement Core_UserStatement Core_TypeRule : Show, Read + +DATA Core_TypingStrategy + | Siblings + functions : {[String]} + | TypingStrategy + typeEnv : {[(String, Tp)]} + typerule : Core_TypeRule + statements : Core_UserStatements + +DATA Core_TypeRule + | TypeRule + premises : Core_Judgements + conclusion : Core_Judgement + +TYPE Core_Judgements = [Core_Judgement] +DATA Core_Judgement + | Judgement + expression : String + type : Tp + +TYPE Core_UserStatements = [Core_UserStatement] + +DATA Core_UserStatement + | Equal + leftType : Tp + rightType : Tp + message : String + | Pred + predClass : String + predType : Tp + message : String + | MetaVariableConstraints + name : String + | CorePhase + phase : Int + +{ +type Core_TypingStrategies = [Core_TypingStrategy] +} diff --git a/src/Helium/StaticAnalysis/Directives/TS_CoreSyntax.hs b/src/Helium/StaticAnalysis/Directives/TS_CoreSyntax.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_CoreSyntax.hs @@ -0,0 +1,28 @@ + + +-- UUAGC 0.9.42.2 (Helium/StaticAnalysis/Directives/TS_CoreSyntax.ag) +module Helium.StaticAnalysis.Directives.TS_CoreSyntax where + +import Top.Types + +type Core_TypingStrategies = [Core_TypingStrategy] +-- Core_Judgement ---------------------------------------------- +data Core_Judgement = Judgement (String) (Tp) + deriving ( Read,Show) +-- Core_Judgements --------------------------------------------- +type Core_Judgements = [Core_Judgement] +-- Core_TypeRule ----------------------------------------------- +data Core_TypeRule = TypeRule (Core_Judgements) (Core_Judgement) + deriving ( Read,Show) +-- Core_TypingStrategy ----------------------------------------- +data Core_TypingStrategy = Siblings (([String])) + | TypingStrategy (([(String, Tp)])) (Core_TypeRule) (Core_UserStatements) + deriving ( Read,Show) +-- Core_UserStatement ------------------------------------------ +data Core_UserStatement = Equal (Tp) (Tp) (String) + | Pred (String) (Tp) (String) + | MetaVariableConstraints (String) + | CorePhase (Int) + deriving ( Read,Show) +-- Core_UserStatements ----------------------------------------- +type Core_UserStatements = [Core_UserStatement] diff --git a/src/Helium/StaticAnalysis/Directives/TS_Messages.hs b/src/Helium/StaticAnalysis/Directives/TS_Messages.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_Messages.hs @@ -0,0 +1,91 @@ +{-| Module : TS_Messages + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + The error messages and warnings that are produced when a .type file is + compiled. + + (directives based on "Scripting the Type Inference Process", ICFP 2003) +-} + +module Helium.StaticAnalysis.Directives.TS_Messages where + +import Helium.StaticAnalysis.Messages.Messages +import Helium.StaticAnalysis.Messages.TypeErrors +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Helium.StaticAnalysis.Messages.HeliumMessages () -- instance Show MessageLines +import Top.Types +import Helium.Utils.Utils (commaList) +import Helium.Syntax.UHA_Syntax + +type TS_Errors = [TS_Error] +data TS_Error + = InconsistentConstraint String {- rule name -} ConstraintInfo + | UndefinedTS String {- rule name -} Name {- variable/constructor -} Entity + | UnusedMetaVariable String {- rule name -} String {- metavariable -} + | DuplicatedMetaVariablesPremise String {- rule name -} String {- metavariable -} + | DuplicatedMetaVariablesConclusion String {- rule name -} String {- metavariable -} + | DuplicatedMetaVariableConstraints String {- rule name -} String {- metavariable -} + | TypeErrorTS String TypeError + | Soundness String {- rule name -} TpScheme {- inferredTpScheme -} TpScheme {- constraintsTpScheme -} + +type TS_Warnings = [TS_Warning] +data TS_Warning + = MetaVariableConstraintsNotExplicit String {- rule name -} [String] {- metavariable -} + +instance HasMessage TS_Error where + getMessage = (:[]) . MessageOneLiner . MessageString . showTS_Error + getRanges _ = [] + +instance HasMessage TS_Warning where + getMessage = (:[]) . MessageOneLiner . MessageString . showTS_Warning + getRanges _ = [] + +showTS_Error :: TS_Error -> String +showTS_Error tsError = case tsError of + (InconsistentConstraint rule hci) -> + let (t1,t2) = typepair hci + in "Error in type strategy rule "++show rule++": "++ + "the given constraint set was inconsistent while solving the constraint "++ + show t1++" == "++show t2 + + (UndefinedTS rule name entity) -> + "Undefined "++show entity++" "++show name++" in type strategy rule "++show rule + + (UnusedMetaVariable rule metavariable) -> + "Unused meta-variable "++show metavariable++" in type strategy rule "++show rule + + (DuplicatedMetaVariablesPremise rule metavariable) -> + "Duplicated meta-variable "++show metavariable++" in premise of type strategy rule "++show rule + + (DuplicatedMetaVariablesConclusion rule metavariable) -> + "Duplicated meta-variable "++show metavariable++" in conclusion of type strategy rule "++show rule + + (DuplicatedMetaVariableConstraints rule metavariable) -> + "The constraints for meta-variable "++show metavariable++" of type strategy rule "++show rule++ + " can only be inserted at one place" + + (TypeErrorTS rule typeError) -> + "Type error in type strategy rule "++show rule++" while inferring the type of the conclusion:\n" ++ + show (getMessage typeError) + + (Soundness rule inferred strategy) -> + unlines [ "The type rule for " ++ show rule ++ " is not correct" + , " the type according to the type rule is" + , " " ++ show strategy + , " whereas the standard type rules infer the type" + , " " ++ show inferred + ] + +showTS_Warning :: TS_Warning -> String +showTS_Warning tsWarning = case tsWarning of + + (MetaVariableConstraintsNotExplicit rule metavariables) -> + "The constraint set"++(if length metavariables > 1 then "s" else "") + ++ " for the meta variable"++(if length metavariables > 1 then "s " else " ") + ++ commaList metavariables + ++ " in the type strategy rule "++show rule + ++" are not inserted explicitly. By default, they are inserted in the beginning." diff --git a/src/Helium/StaticAnalysis/Directives/TS_Parser.hs b/src/Helium/StaticAnalysis/Directives/TS_Parser.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_Parser.hs @@ -0,0 +1,116 @@ +{-| Module : TS_Parser + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + The parser of a .type file. + + (directives based on "Scripting the Type Inference Process", ICFP 2003) +-} + +module Helium.StaticAnalysis.Directives.TS_Parser where + +-- UHA +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils (nameFromString) +import qualified Helium.Syntax.UHA_Pretty as PP +-- Typing strategies +import Helium.StaticAnalysis.Directives.TS_Syntax +import Helium.Parser.Lexer (Token, Lexeme) +import Helium.Parser.ParseLibrary hiding (satisfy) +import Helium.Parser.Parser (exp0, type_, atype) +import qualified Helium.Parser.ResolveOperators as ResolveOperators +import Text.ParserCombinators.Parsec + +import Data.List (intersperse, intercalate) +import Helium.Parser.OperatorTable +import Helium.Utils.Utils (internalError) + +parseTypingStrategies :: OperatorTable -> String -> [Token] -> Either ParseError TypingStrategies +parseTypingStrategies operatorTable filename toks = + runHParser (many parseTypingStrategy) filename toks True {- wait for EOF -} + + where + + parseTypingStrategy :: HParser TypingStrategy + parseTypingStrategy = + do lexSIBLINGS + names <- commas1 (var <|> varop <|> con <|> conop <|> special) + lexSEMI + return (TypingStrategy_Siblings names) + <|> + do typerule <- parseTypeRule + constraints <- many parseConstraint + lexSEMI + return (TypingStrategy_TypingStrategy typerule constraints) + + parseTypeRule :: HParser TypeRule + parseTypeRule = + do judgements <- many1 parseJudgement + lexSEMI + let (premises, conclusion) = (init judgements, last judgements) + return (TypeRule_TypeRule (map judgementToSimpleJudgement premises) conclusion) + + parseJudgement :: HParser Judgement + parseJudgement = + do expression <- exp0 + lexCOLCOL + exprType <- type_ + lexSEMI + let resolvedExpression = ResolveOperators.expression operatorTable expression + return (Judgement_Judgement resolvedExpression exprType) + + parseConstraint :: HParser UserStatement + parseConstraint = + do -- enter a new phase + lexPHASE + phase <- fmap read lexInt + return (UserStatement_Phase (fromInteger phase)) + <|> + do -- constraint set of meta-variable + lexCONSTRAINTS + theName <- varid + return (UserStatement_MetaVariableConstraints theName) + <|> + parseUserConstraint + + parseUserConstraint :: HParser UserStatement + parseUserConstraint = try pPredicate <|> pEquality + + where + pPredicate = + do -- user predicate + predClass <- con + predType <- atype + lexCOL + msgLines <- many1 lexString + let message = concat (intersperse "\n" msgLines) + return (UserStatement_Pred predClass predType message) + + pEquality = + do -- user equality constraint + leftType <- type_ + lexASGASG + rightType <- type_ + lexCOL + msgLines <- many1 lexString + let message = intercalate "\n" msgLines + return (UserStatement_Equal leftType rightType message) + +special :: GenParser (SourcePos,Lexeme) SourcePos Name +special = do lexCOL ; return (nameFromString ":") + <|> do lexASGASG ; return (nameFromString "==") + +judgementToSimpleJudgement :: Judgement -> SimpleJudgement +judgementToSimpleJudgement judgement = + case judgement of + Judgement_Judgement (Expression_Variable _ theName) tp + -> SimpleJudgement_SimpleJudgement theName tp + Judgement_Judgement expression _ + -> internalError "TS_Parser.hs" "judgementToSimpleJudgement" + ("the following expression should have been a meta-variable: "++showExpression expression) + +showExpression :: Expression -> String +showExpression e = show $ PP.text_Syn_Expression $ PP.wrap_Expression (PP.sem_Expression e) PP.Inh_Expression diff --git a/src/Helium/StaticAnalysis/Directives/TS_PatternMatching.ag b/src/Helium/StaticAnalysis/Directives/TS_PatternMatching.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_PatternMatching.ag @@ -0,0 +1,433 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Try to match the specialized type rules with the abstract syntax tree at +-- hand. If a specialized type rule can be applied at the certain node in the +-- tree, then a different set of constraints is inserted instead of the +-- standard ones. +-- +-- (directives based on "Scripting the Type Inference Process", ICFP 2003) +----------------------------------------------------------------------------- + +imports { + +import Data.List +import Helium.StaticAnalysis.Directives.Matchers +import Helium.StaticAnalysis.Directives.TS_Apply (applyTypingStrategy, matchInformation) +import Helium.StaticAnalysis.Directives.TS_CoreSyntax +import Helium.StaticAnalysis.Directives.TS_Attributes + +} + +ATTR Body Statement Qualifier Statements Qualifiers Expression RightHandSide MaybeExpression + Expressions GuardedExpression GuardedExpressions FunctionBinding FunctionBindings + Declaration Declarations MaybeDeclarations Alternative Alternatives + [ | matchIO : {IO ()} | ] + +SEM Module | Module body . matchIO = return () + +--------------------------------------------------------------------------------------------------------- + +ATTR Expressions Expression MaybeExpression + GuardedExpression GuardedExpressions + Qualifiers Qualifier + Statements Statement + [ | uniqueSecondRound : Int | ] + +SEM RightHandSide + | Expression + expression . uniqueSecondRound = @expression.betaUnique + where . betaUnique = @expression.uniqueSecondRound + + | Guarded + guardedexpressions . uniqueSecondRound = @guardedexpressions.betaUnique + where . betaUnique = @guardedexpressions.uniqueSecondRound + + +--------------------------------------------------------------------------------------------------------- + +ATTR Body Expression Expressions MaybeExpression Statements Statement Qualifiers Qualifier + GuardedExpression GuardedExpressions FunctionBinding FunctionBindings + Declaration Declarations MaybeDeclarations RightHandSide Alternative Alternatives + [ allPatterns : {[((Expression, [String]), Core_TypingStrategy)]} | | ] + +SEM Module + | Module + body . allPatterns = [ (matchInfo, typingStrategy) + | typingStrategy <- typingStrategies @lhs.importEnvironment + , matchInfo <- matchInformation + @lhs.importEnvironment + typingStrategy + ] + +--------------------------------------------------------------------------------------------------------- + +ATTR Expressions [ tryPatterns : {[(Expressions , [String])]} | | ] +ATTR Expression [ tryPatterns : {[(Expression , [String])]} | | ] +ATTR MaybeExpression [ tryPatterns : {[(MaybeExpression, [String])]} | | ] + +--------------------------------------------------------------------------------------------------------- + +ATTR Expression Expressions MaybeExpression [ | | matches : {[Maybe MetaVariableTable]} ] + +SEM Expression + | Literal + ((), lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch) = + let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in match0 infoTuple @lhs.uniqueSecondRound + (match_Expression_Literal @literal.self) + @lhs.tryPatterns @lhs.allPatterns + [] + + | Variable + ((), lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch) = + let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in match0 infoTuple @lhs.uniqueSecondRound + (match_Expression_Variable @name.self) + @lhs.tryPatterns @lhs.allPatterns + [] + + | Hole + ((), lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch) = + let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in match0 infoTuple @lhs.uniqueSecondRound + (const Nothing) + @lhs.tryPatterns @lhs.allPatterns + [] + + | Constructor + ((), lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch) = + let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in match0 infoTuple @lhs.uniqueSecondRound + (match_Expression_Constructor @name.self) + @lhs.tryPatterns @lhs.allPatterns + [] + + | NormalApplication + ( (function.tryPatterns, arguments.tryPatterns) + , lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch + ) = let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in match2 infoTuple @arguments.uniqueSecondRound + match_Expression_NormalApplication + @lhs.tryPatterns @lhs.allPatterns + [@function.matches, @arguments.matches] + + | InfixApplication + ( (leftExpression.tryPatterns, operator.tryPatterns, rightExpression.tryPatterns) + , lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch + ) = let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in match3 infoTuple @rightExpression.uniqueSecondRound + match_Expression_InfixApplication + @lhs.tryPatterns @lhs.allPatterns + [@leftExpression.matches, @operator.matches,@rightExpression.matches] + + | If + ( (guardExpression.tryPatterns, thenExpression.tryPatterns, elseExpression.tryPatterns) + , lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch + ) = let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in match3 infoTuple @elseExpression.uniqueSecondRound + match_Expression_If + @lhs.tryPatterns @lhs.allPatterns + [@guardExpression.matches,@thenExpression.matches,@elseExpression.matches] + + | List + (expressions.tryPatterns, lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch) = + let infoTuple = metaVarInfo @constraints @expressions.assumptions @localInfo + in match1 infoTuple @expressions.uniqueSecondRound + match_Expression_List + @lhs.tryPatterns @lhs.allPatterns + [@expressions.matches] + + | Tuple + (expressions.tryPatterns, lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch) = + let infoTuple = metaVarInfo @constraints @expressions.assumptions @localInfo + in match1 infoTuple @expressions.uniqueSecondRound + match_Expression_Tuple + @lhs.tryPatterns @lhs.allPatterns + [@expressions.matches] + + | Enum + ( (from.tryPatterns, then.tryPatterns, to.tryPatterns) + , lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch + ) = let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in match3 infoTuple @to.uniqueSecondRound + match_Expression_Enum + @lhs.tryPatterns @lhs.allPatterns + [@from.matches, @then.matches, @to.matches] + + + | Negate + (expression.tryPatterns, lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch) = + let infoTuple = metaVarInfo @constraints @expression.assumptions @localInfo + in match1 infoTuple @expression.uniqueSecondRound + match_Expression_Negate + @lhs.tryPatterns @lhs.allPatterns + [@expression.matches] + + | NegateFloat + (expression.tryPatterns, lhs.matches, lhs.constraints, lhs.assumptions, lhs.uniqueSecondRound, loc.ioMatch) = + let infoTuple = metaVarInfo @constraints @expression.assumptions @localInfo + in match1 infoTuple @expression.uniqueSecondRound + match_Expression_NegateFloat + @lhs.tryPatterns @lhs.allPatterns + [@expression.matches] + +SEM Expressions + | Cons + ((hd.tryPatterns,tl.tryPatterns), lhs.matches, _, _, _, _) = + match2' match_Expressions_Cons @lhs.tryPatterns [] [@hd.matches, @tl.matches] + + | Nil + ((), lhs.matches, _, _, _, _) = + match0' match_Expressions_Nil @lhs.tryPatterns [] [] + +SEM MaybeExpression + | Just + (expression.tryPatterns, lhs.matches, _, _ , _, _) = + match1' match_MaybeExpression_Just @lhs.tryPatterns [] [@expression.matches] + + | Nothing + ((), lhs.matches, _, _, _, _) = + match0' match_MaybeExpression_Nothing @lhs.tryPatterns [] [] + +--------------------------------------------------------------- +-- Expressions that can only match with a meta variable. + +SEM Expression + | Lambda + lhs.matches = + let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in matchOnlyVariable infoTuple @lhs.tryPatterns + + | Case + lhs.matches = + let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in matchOnlyVariable infoTuple @lhs.tryPatterns + + | Let + lhs.matches = + let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in matchOnlyVariable infoTuple @lhs.tryPatterns + + | Do + lhs.matches = + let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in matchOnlyVariable infoTuple @lhs.tryPatterns + + | Comprehension + lhs.matches = + let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in matchOnlyVariable infoTuple @lhs.tryPatterns + + | Typed + lhs.matches = + let infoTuple = metaVarInfo @constraints @assumptions @localInfo + in matchOnlyVariable infoTuple @lhs.tryPatterns + +SEM Expression + | Lambda expression . tryPatterns = [] + | Case expression . tryPatterns = [] + | Let expression . tryPatterns = [] + | Comprehension expression . tryPatterns = [] + | Typed expression . tryPatterns = [] + +SEM Statement + | Expression expression . tryPatterns = [] + | Generator expression . tryPatterns = [] + +SEM Qualifier + | Guard guard . tryPatterns = [] + | Generator expression . tryPatterns = [] + +SEM GuardedExpression + | GuardedExpression guard . tryPatterns = [] + expression . tryPatterns = [] + +SEM RightHandSide + | Expression expression . tryPatterns = [] + +--------------------------------------------------------------- +-- Debug IO: matches + +SEM Expression + | Literal lhs.matchIO = @lhs.matchIO >> @ioMatch + | Variable lhs.matchIO = @lhs.matchIO >> @ioMatch +-- | Hole lhs.matchIO = @lhs.matchIO >> @ioMatch + | Constructor lhs.matchIO = @lhs.matchIO >> @ioMatch + | NormalApplication lhs.matchIO = @arguments.matchIO >> @ioMatch + | InfixApplication lhs.matchIO = @rightExpression.matchIO >> @ioMatch + | If lhs.matchIO = @elseExpression.matchIO >> @ioMatch + | List lhs.matchIO = @expressions.matchIO >> @ioMatch + | Tuple lhs.matchIO = @expressions.matchIO >> @ioMatch + | Enum lhs.matchIO = @to.matchIO >> @ioMatch + | Negate lhs.matchIO = @expression.matchIO >> @ioMatch + | NegateFloat lhs.matchIO = @expression.matchIO >> @ioMatch + +--------------------------------------------------------------------------------------------------------- + +{ +matchConverter0 :: [([String],())] -> () +matchConverter0 = const () + +matchConverter1 :: [([String],a)] -> [(a,[String])] +matchConverter1 = map (\(a,b) -> (b,a)) + +matchConverter2 :: [([String],(a,b))] -> ([(a,[String])],[(b,[String])]) +matchConverter2 = let localInsert (metas,(a,b)) (as,bs) = ((a,metas):as,(b,metas):bs) + in foldr localInsert ([],[]) + +matchConverter3 :: [([String],(a,b,c))] -> ([(a,[String])],[(b,[String])],[(c,[String])]) +matchConverter3 = let localInsert (metas,(a,b,c)) (as,bs,cs) = ((a,metas):as,(b,metas):bs,(c,metas):cs) + in foldr localInsert ([],[],[]) + +allMatch :: [Maybe [a]] -> Maybe [a] +allMatch = rec_ [] + where rec_ xs [] = Just xs + rec_ _ (Nothing:_) = Nothing + rec_ xs (Just ys:rest) = rec_ (ys ++ xs) rest + +data Match a = NoMatch | NonTerminalMatch a | MetaVariableMatch String + +instance Show (Match a) where + show (NoMatch) = "NoMatch" + show (NonTerminalMatch _) = "NonTerminal ??" + show (MetaVariableMatch s) = "MetaVariableMatch "++show s + +expressionVariableMatcher :: Expression -> Maybe String +expressionVariableMatcher expr = + case expr of + Expression_Variable _ name -> Just (show name) + _ -> Nothing + +match0 :: MetaVariableInfo -> Int -> (Expression -> Maybe ()) + -> [(Expression, [String])] + -> [((Expression, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> ((), [Maybe MetaVariableTable], ConstraintSet, Assumptions, Int, IO ()) +match0 = generalMatch expressionVariableMatcher matchConverter0 + +match1 :: MetaVariableInfo -> Int -> (Expression -> Maybe a) + -> [(Expression, [String])] + -> [((Expression, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> ([(a, [String])], [Maybe MetaVariableTable], + ConstraintSet, Assumptions, Int, IO ()) +match1 = generalMatch expressionVariableMatcher matchConverter1 + +match2 :: MetaVariableInfo -> Int -> (Expression -> Maybe (a, b)) + -> [(Expression, [String])] + -> [((Expression, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> (([(a, [String])], [(b, [String])]), [Maybe MetaVariableTable], + ConstraintSet, Assumptions, Int, IO ()) +match2 = generalMatch expressionVariableMatcher matchConverter2 + +match3 :: MetaVariableInfo -> Int -> (Expression -> Maybe (a, b, c)) + -> [(Expression, [String])] + -> [((Expression, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> (([(a, [String])], [(b, [String])], [(c, [String])]), + [Maybe MetaVariableTable], ConstraintSet, + Assumptions, Int, IO ()) +match3 = generalMatch expressionVariableMatcher matchConverter3 + +match0' :: (a -> Maybe ()) -> [(a, [String])] + -> [((a, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> ((), [Maybe MetaVariableTable], ConstraintSet, + Assumptions, Int, IO ()) +match0' = generalMatch noMatch matchConverter0 noMetaVariableInfo 0 + +match1' :: (a -> Maybe b) -> [(a, [String])] + -> [((a, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] -> + ([(b, [String])], [Maybe MetaVariableTable], + ConstraintSet, Assumptions, Int, IO ()) +match1' = generalMatch noMatch matchConverter1 noMetaVariableInfo 0 + +match2' :: (n -> Maybe (a, b)) -> [(n, [String])] + -> [((n, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> (([(a, [String])], [(b, [String])]), + [Maybe MetaVariableTable], ConstraintSet, Assumptions, Int, IO ()) +match2' = generalMatch noMatch matchConverter2 noMetaVariableInfo 0 + +matchOnlyVariable :: MetaVariableInfo -> [(Expression, [String])] -> [Maybe MetaVariableTable] +matchOnlyVariable infoTuple tryPats = + let ((),matches,_,_,_,_) = match0 infoTuple 0 noMatch tryPats [] [] + in matches + +noMatch :: a -> Maybe b +noMatch = const Nothing + +noMetaVariableInfo :: a +noMetaVariableInfo = internalError "PatternMatching.ag" "noMetaVariableInfo" "" + +generalMatch :: (nonTerminal -> Maybe String) + -> ([([String], childrenTuple)] -> childrenResult) + -> MetaVariableInfo + -> Int + -> (nonTerminal -> Maybe childrenTuple) + -> [(nonTerminal, [String])] + -> [((nonTerminal, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> ( childrenResult + , [Maybe MetaVariableTable] + , ConstraintSet + , Assumptions + , Int + , IO () + ) + +generalMatch exprVarMatcher converter metaInfo unique matcher tryPats allPats childrenResults = + let match (expr,metas) = + case exprVarMatcher expr of + Just s | s `elem` metas -> MetaVariableMatch s + _ -> case matcher expr of + Just x -> NonTerminalMatch (metas,x) + Nothing -> NoMatch + + (allPatterns, allStrategies) = unzip allPats + matchListTry = map match tryPats + matchListNew = map match allPatterns + + matchNTTry = [ x | NonTerminalMatch x <- matchListTry ] + matchNTNew = [ x | NonTerminalMatch x <- matchListNew ] + forChildren = converter (matchNTTry ++ matchNTNew) + + numberOfTry = length matchNTTry + (resultTry,resultNew) = unzip . map (splitAt numberOfTry) $ + if null childrenResults + then [repeat (Just [])] + else childrenResults + inspectMatch m (res, nts) = + case m of + NoMatch -> (Nothing:res, nts) + NonTerminalMatch _ -> (allMatch (head nts):res, tail nts) + MetaVariableMatch s -> (Just [(s, metaInfo)]:res, nts) -- !!! + + result = fst (foldr inspectMatch ([],reverse $ transpose resultTry) matchListTry) + complete = let (list,_) = foldr inspectMatch ([],reverse $ transpose resultNew) matchListNew + in [ (x, y) | (Just x, y) <- zip list allStrategies ] + + (assumptions, constraintSet, debugIO, newUnique) = + case complete of + + [] -> (getAssumptions metaInfo, getConstraintSet metaInfo, return (), unique) + + (childrenInfo, typingStrategy):_ + -> applyTypingStrategy typingStrategy metaInfo childrenInfo unique + in (forChildren, result, constraintSet, assumptions, newUnique, debugIO) +} + +-- prevent ag-warnings +SEM RecordExpressionBinding + | RecordExpressionBinding + loc . (allPatterns,tryPatterns,matchIO,uniqueSecondRound) = internalError "TS_PatternMatching.ag" "n/a" "RecordExpressionBinding is not supported" +SEM Expression + | RecordConstruction + loc . matches = internalError "TS_PatternMatching.ag" "n/a" "RecordConstruction is not supported" diff --git a/src/Helium/StaticAnalysis/Directives/TS_Syntax.ag b/src/Helium/StaticAnalysis/Directives/TS_Syntax.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_Syntax.ag @@ -0,0 +1,57 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- A datatype for type inference directives. +-- +-- (directives based on "Scripting the Type Inference Process", ICFP 2003) +----------------------------------------------------------------------------- + +imports { +import Helium.Syntax.UHA_Syntax +} + +TYPE TypingStrategies = [TypingStrategy] + +DATA TypingStrategy + | Siblings + names : Names + | TypingStrategy + typerule : TypeRule + statements : UserStatements + +DATA TypeRule + | TypeRule + premises : SimpleJudgements + conclusion : Judgement + +DATA Judgement + | Judgement + expression : Expression + type : Type + +TYPE SimpleJudgements = [SimpleJudgement] + +DATA SimpleJudgement + | SimpleJudgement + name : Name + type : Type + +TYPE UserStatements = [UserStatement] + +DATA UserStatement + | Equal + leftType : Type + rightType : Type + message : String + | Pred + predClass : Name + predType : Type + message : String + | MetaVariableConstraints + name : Name + | Phase + phase : Int diff --git a/src/Helium/StaticAnalysis/Directives/TS_Syntax.hs b/src/Helium/StaticAnalysis/Directives/TS_Syntax.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_Syntax.hs @@ -0,0 +1,26 @@ + + +-- UUAGC 0.9.42.2 (Helium/StaticAnalysis/Directives/TS_Syntax.ag) +module Helium.StaticAnalysis.Directives.TS_Syntax where + +import Helium.Syntax.UHA_Syntax +-- Judgement --------------------------------------------------- +data Judgement = Judgement_Judgement (Expression) (Type) +-- SimpleJudgement --------------------------------------------- +data SimpleJudgement = SimpleJudgement_SimpleJudgement (Name) (Type) +-- SimpleJudgements -------------------------------------------- +type SimpleJudgements = [SimpleJudgement] +-- TypeRule ---------------------------------------------------- +data TypeRule = TypeRule_TypeRule (SimpleJudgements) (Judgement) +-- TypingStrategies -------------------------------------------- +type TypingStrategies = [TypingStrategy] +-- TypingStrategy ---------------------------------------------- +data TypingStrategy = TypingStrategy_Siblings (Names) + | TypingStrategy_TypingStrategy (TypeRule) (UserStatements) +-- UserStatement ----------------------------------------------- +data UserStatement = UserStatement_Equal (Type) (Type) (String) + | UserStatement_Pred (Name) (Type) (String) + | UserStatement_MetaVariableConstraints (Name) + | UserStatement_Phase (Int) +-- UserStatements ---------------------------------------------- +type UserStatements = [UserStatement] diff --git a/src/Helium/StaticAnalysis/Directives/TS_ToCore.ag b/src/Helium/StaticAnalysis/Directives/TS_ToCore.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_ToCore.ag @@ -0,0 +1,124 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Translate the type inference directives into a core datatype. In this core +-- datatype, type variable identifiers are (for instance) replaced by standard +-- type variables (ints). +-- +-- (directives based on "Scripting the Type Inference Process", ICFP 2003) +----------------------------------------------------------------------------- + +{ +typingStrategyToCore :: ImportEnvironment -> TypingStrategy -> Core_TypingStrategy +typingStrategyToCore importEnv strategy = + core_Syn_TypingStrategy (wrap_TypingStrategy (sem_TypingStrategy strategy) Inh_TypingStrategy { importEnvironment_Inh_TypingStrategy = importEnv }) +} + +INCLUDE "TS_Syntax.ag" +INCLUDE "TS_Collect.ag" +INCLUDE "UHA_Syntax.ag" + +imports { +import Helium.StaticAnalysis.Directives.TS_Syntax +import Helium.StaticAnalysis.Directives.TS_CoreSyntax +import Helium.ModuleSystem.ImportEnvironment +import Helium.StaticAnalysis.Messages.Messages +import Top.Types + +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Helium.Syntax.UHA_Utils (getNameName, nameFromString) +import qualified Helium.Syntax.UHA_OneLine as UHA_OneLine +import Helium.StaticAnalysis.Miscellaneous.TypeConversion +import Helium.Utils.Utils (internalError) +import Data.List +import Helium.Utils.OneLiner +import Helium.StaticAnalysis.Directives.TS_Attributes +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints + +} +ATTR TypingStrategies TypingStrategy [ importEnvironment : ImportEnvironment | | ] + +SEM TypingStrategy [ | | core : Core_TypingStrategy ] + | Siblings + lhs . core = Siblings (map getNameName @names.self) + | TypingStrategy + lhs . core = TypingStrategy @typeEnv @typerule.core @statements.core + loc . nameMap = zip @uniqueTypevariables (map TVar [0..]) + +SEM TypeRule [ | | core : Core_TypeRule ] + | TypeRule + lhs . core = TypeRule @premises.core @conclusion.core + +SEM Judgement [ | | core : Core_Judgement ] + | Judgement + lhs . core = Judgement (showOneLine 10000 $ UHA_OneLine.oneLineTree_Syn_Expression $ UHA_OneLine.wrap_Expression (UHA_OneLine.sem_Expression @expression.self) UHA_OneLine.Inh_Expression) (makeTpFromType @lhs.nameMap @type.self) + +SEM SimpleJudgements [ | | core : Core_Judgements ] + | Cons lhs . core = @hd.core : @tl.core + | Nil lhs . core = [] + +SEM SimpleJudgement [ | | core : Core_Judgement ] + | SimpleJudgement + lhs . core = Judgement (show @name.self) (makeTpFromType @lhs.nameMap @type.self) + +SEM UserStatements [ | | core : Core_UserStatements ] + | Cons lhs . core = @hd.core : @tl.core + | Nil lhs . core = [] + +SEM UserStatement [ | | core : Core_UserStatement ] + | Equal lhs . core = Equal + (makeTpFromType @lhs.nameMap @leftType.self) + (makeTpFromType @lhs.nameMap @rightType.self) + (changeAttributes (useNameMap @lhs.nameMap) @message) + | Pred lhs . core = Pred + (show @predClass.self) + (makeTpFromType @lhs.nameMap @predType.self) + (changeAttributes (useNameMap @lhs.nameMap) @message) + | MetaVariableConstraints lhs . core = MetaVariableConstraints (show @name.self) + | Phase lhs . core = CorePhase @phase + +-- collecting the fixed constant types +-- +-- This approach to determine the types of the fixed constants does not work in general! +-- For the moment, the type variables assigned to the premises and the conclusion are skolemized +-- (in particular, when building the newEnvironment). In some cases however, this results in +-- a type inconsistency: +-- For instance: +-- f : t1 => f id ::t2 (f is a meta-variable, id has the type forall a . a -> a) +-- in this case, the type for id cannot be expressed in t1 and t2 (since t1 is in fact a function type) +-- +-- Todo: fix this problem. + +SEM TypingStrategy + | TypingStrategy + loc . typeEnv = + let newEnvironment = + let list = [ (nameFromString s, toTpScheme $ freezeVariablesInType tp) + | (s, tp) <- ("$$conclusion", @typerule.conclusionType) : @typerule.simpleJudgements + ] + in @lhs.importEnvironment { typeEnvironment = M.fromList list } + (inferredType, freeVariables, _) = expressionTypeInferencer newEnvironment @typerule.conclusionExpression + monoType = unqualify (unquantify inferredType) + synonyms = getOrderedTypeSynonyms @lhs.importEnvironment + sub = case mguWithTypeSynonyms synonyms monoType (freezeVariablesInType @typerule.conclusionType) of + Left _ -> internalError "TS_ToCore.ag" "n/a" "no unification possible" + Right (_, s) -> s + in [ (show name, unfreezeVariablesInType (sub |-> tp)) + | (name, tp) <- concat (M.elems freeVariables) + ] + +{ +useNameMap :: [(Name, Tp)] -> Attribute -> Attribute +useNameMap nameMap attribute = + case attribute of + LocalAttribute s -> + case lookup s [ (show n, i) | (n, TVar i) <- nameMap ] of + Just i -> LocalAttribute (show i) + Nothing -> attribute + _ -> attribute + +} diff --git a/src/Helium/StaticAnalysis/Directives/TS_ToCore.hs b/src/Helium/StaticAnalysis/Directives/TS_ToCore.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Directives/TS_ToCore.hs @@ -0,0 +1,4508 @@ + + +-- UUAGC 0.9.42.2 (Helium/StaticAnalysis/Directives/TS_ToCore.ag) +module Helium.StaticAnalysis.Directives.TS_ToCore where + +import Helium.StaticAnalysis.Directives.TS_Syntax +import Helium.StaticAnalysis.Directives.TS_CoreSyntax +import Helium.ModuleSystem.ImportEnvironment +import Helium.StaticAnalysis.Messages.Messages +import Top.Types + +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Helium.Syntax.UHA_Utils (getNameName, nameFromString) +import qualified Helium.Syntax.UHA_OneLine as UHA_OneLine +import Helium.StaticAnalysis.Miscellaneous.TypeConversion +import Helium.Utils.Utils (internalError) +import Data.List +import Helium.Utils.OneLiner +import Helium.StaticAnalysis.Directives.TS_Attributes +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints + + + +import Helium.Syntax.UHA_Syntax + + +import Helium.StaticAnalysis.Inferencers.ExpressionTypeInferencer (expressionTypeInferencer) +import qualified Data.Map as M + +typingStrategyToCore :: ImportEnvironment -> TypingStrategy -> Core_TypingStrategy +typingStrategyToCore importEnv strategy = + core_Syn_TypingStrategy (wrap_TypingStrategy (sem_TypingStrategy strategy) Inh_TypingStrategy { importEnvironment_Inh_TypingStrategy = importEnv }) + + +useNameMap :: [(Name, Tp)] -> Attribute -> Attribute +useNameMap nameMap attribute = + case attribute of + LocalAttribute s -> + case lookup s [ (show n, i) | (n, TVar i) <- nameMap ] of + Just i -> LocalAttribute (show i) + Nothing -> attribute + _ -> attribute + +-- Alternative ------------------------------------------------- +-- cata +sem_Alternative :: Alternative -> + T_Alternative +sem_Alternative (Alternative_Hole _range _id) = + (sem_Alternative_Hole (sem_Range _range) _id) +sem_Alternative (Alternative_Feedback _range _feedback _alternative) = + (sem_Alternative_Feedback (sem_Range _range) _feedback (sem_Alternative _alternative)) +sem_Alternative (Alternative_Alternative _range _pattern _righthandside) = + (sem_Alternative_Alternative (sem_Range _range) (sem_Pattern _pattern) (sem_RightHandSide _righthandside)) +sem_Alternative (Alternative_Empty _range) = + (sem_Alternative_Empty (sem_Range _range)) +-- semantic domain +type T_Alternative = ( Alternative) +data Inh_Alternative = Inh_Alternative {} +data Syn_Alternative = Syn_Alternative {self_Syn_Alternative :: Alternative} +wrap_Alternative :: T_Alternative -> + Inh_Alternative -> + Syn_Alternative +wrap_Alternative sem (Inh_Alternative) = + (let ( _lhsOself) = sem + in (Syn_Alternative _lhsOself)) +sem_Alternative_Hole :: T_Range -> + Integer -> + T_Alternative +sem_Alternative_Hole range_ id_ = + (let _lhsOself :: Alternative + _rangeIself :: Range + _self = + Alternative_Hole _rangeIself id_ + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_Alternative_Feedback :: T_Range -> + String -> + T_Alternative -> + T_Alternative +sem_Alternative_Feedback range_ feedback_ alternative_ = + (let _lhsOself :: Alternative + _rangeIself :: Range + _alternativeIself :: Alternative + _self = + Alternative_Feedback _rangeIself feedback_ _alternativeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _alternativeIself) = + alternative_ + in ( _lhsOself)) +sem_Alternative_Alternative :: T_Range -> + T_Pattern -> + T_RightHandSide -> + T_Alternative +sem_Alternative_Alternative range_ pattern_ righthandside_ = + (let _lhsOself :: Alternative + _rangeIself :: Range + _patternIself :: Pattern + _righthandsideIself :: RightHandSide + _self = + Alternative_Alternative _rangeIself _patternIself _righthandsideIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _patternIself) = + pattern_ + ( _righthandsideIself) = + righthandside_ + in ( _lhsOself)) +sem_Alternative_Empty :: T_Range -> + T_Alternative +sem_Alternative_Empty range_ = + (let _lhsOself :: Alternative + _rangeIself :: Range + _self = + Alternative_Empty _rangeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +-- Alternatives ------------------------------------------------ +-- cata +sem_Alternatives :: Alternatives -> + T_Alternatives +sem_Alternatives list = + (Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list)) +-- semantic domain +type T_Alternatives = ( Alternatives) +data Inh_Alternatives = Inh_Alternatives {} +data Syn_Alternatives = Syn_Alternatives {self_Syn_Alternatives :: Alternatives} +wrap_Alternatives :: T_Alternatives -> + Inh_Alternatives -> + Syn_Alternatives +wrap_Alternatives sem (Inh_Alternatives) = + (let ( _lhsOself) = sem + in (Syn_Alternatives _lhsOself)) +sem_Alternatives_Cons :: T_Alternative -> + T_Alternatives -> + T_Alternatives +sem_Alternatives_Cons hd_ tl_ = + (let _lhsOself :: Alternatives + _hdIself :: Alternative + _tlIself :: Alternatives + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = + (let _lhsOself :: Alternatives + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- AnnotatedType ----------------------------------------------- +-- cata +sem_AnnotatedType :: AnnotatedType -> + T_AnnotatedType +sem_AnnotatedType (AnnotatedType_AnnotatedType _range _strict _type) = + (sem_AnnotatedType_AnnotatedType (sem_Range _range) _strict (sem_Type _type)) +-- semantic domain +type T_AnnotatedType = ( AnnotatedType) +data Inh_AnnotatedType = Inh_AnnotatedType {} +data Syn_AnnotatedType = Syn_AnnotatedType {self_Syn_AnnotatedType :: AnnotatedType} +wrap_AnnotatedType :: T_AnnotatedType -> + Inh_AnnotatedType -> + Syn_AnnotatedType +wrap_AnnotatedType sem (Inh_AnnotatedType) = + (let ( _lhsOself) = sem + in (Syn_AnnotatedType _lhsOself)) +sem_AnnotatedType_AnnotatedType :: T_Range -> + Bool -> + T_Type -> + T_AnnotatedType +sem_AnnotatedType_AnnotatedType range_ strict_ type_ = + (let _lhsOself :: AnnotatedType + _rangeIself :: Range + _typeIself :: Type + _typeItypevariables :: Names + _self = + AnnotatedType_AnnotatedType _rangeIself strict_ _typeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _typeIself,_typeItypevariables) = + type_ + in ( _lhsOself)) +-- AnnotatedTypes ---------------------------------------------- +-- cata +sem_AnnotatedTypes :: AnnotatedTypes -> + T_AnnotatedTypes +sem_AnnotatedTypes list = + (Prelude.foldr sem_AnnotatedTypes_Cons sem_AnnotatedTypes_Nil (Prelude.map sem_AnnotatedType list)) +-- semantic domain +type T_AnnotatedTypes = ( AnnotatedTypes) +data Inh_AnnotatedTypes = Inh_AnnotatedTypes {} +data Syn_AnnotatedTypes = Syn_AnnotatedTypes {self_Syn_AnnotatedTypes :: AnnotatedTypes} +wrap_AnnotatedTypes :: T_AnnotatedTypes -> + Inh_AnnotatedTypes -> + Syn_AnnotatedTypes +wrap_AnnotatedTypes sem (Inh_AnnotatedTypes) = + (let ( _lhsOself) = sem + in (Syn_AnnotatedTypes _lhsOself)) +sem_AnnotatedTypes_Cons :: T_AnnotatedType -> + T_AnnotatedTypes -> + T_AnnotatedTypes +sem_AnnotatedTypes_Cons hd_ tl_ = + (let _lhsOself :: AnnotatedTypes + _hdIself :: AnnotatedType + _tlIself :: AnnotatedTypes + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_AnnotatedTypes_Nil :: T_AnnotatedTypes +sem_AnnotatedTypes_Nil = + (let _lhsOself :: AnnotatedTypes + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Body -------------------------------------------------------- +-- cata +sem_Body :: Body -> + T_Body +sem_Body (Body_Hole _range _id) = + (sem_Body_Hole (sem_Range _range) _id) +sem_Body (Body_Body _range _importdeclarations _declarations) = + (sem_Body_Body (sem_Range _range) (sem_ImportDeclarations _importdeclarations) (sem_Declarations _declarations)) +-- semantic domain +type T_Body = ( Body) +data Inh_Body = Inh_Body {} +data Syn_Body = Syn_Body {self_Syn_Body :: Body} +wrap_Body :: T_Body -> + Inh_Body -> + Syn_Body +wrap_Body sem (Inh_Body) = + (let ( _lhsOself) = sem + in (Syn_Body _lhsOself)) +sem_Body_Hole :: T_Range -> + Integer -> + T_Body +sem_Body_Hole range_ id_ = + (let _lhsOself :: Body + _rangeIself :: Range + _self = + Body_Hole _rangeIself id_ + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_Body_Body :: T_Range -> + T_ImportDeclarations -> + T_Declarations -> + T_Body +sem_Body_Body range_ importdeclarations_ declarations_ = + (let _lhsOself :: Body + _rangeIself :: Range + _importdeclarationsIself :: ImportDeclarations + _declarationsIself :: Declarations + _self = + Body_Body _rangeIself _importdeclarationsIself _declarationsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _importdeclarationsIself) = + importdeclarations_ + ( _declarationsIself) = + declarations_ + in ( _lhsOself)) +-- Constructor ------------------------------------------------- +-- cata +sem_Constructor :: Constructor -> + T_Constructor +sem_Constructor (Constructor_Constructor _range _constructor _types) = + (sem_Constructor_Constructor (sem_Range _range) (sem_Name _constructor) (sem_AnnotatedTypes _types)) +sem_Constructor (Constructor_Infix _range _leftType _constructorOperator _rightType) = + (sem_Constructor_Infix (sem_Range _range) (sem_AnnotatedType _leftType) (sem_Name _constructorOperator) (sem_AnnotatedType _rightType)) +sem_Constructor (Constructor_Record _range _constructor _fieldDeclarations) = + (sem_Constructor_Record (sem_Range _range) (sem_Name _constructor) (sem_FieldDeclarations _fieldDeclarations)) +-- semantic domain +type T_Constructor = ( Constructor) +data Inh_Constructor = Inh_Constructor {} +data Syn_Constructor = Syn_Constructor {self_Syn_Constructor :: Constructor} +wrap_Constructor :: T_Constructor -> + Inh_Constructor -> + Syn_Constructor +wrap_Constructor sem (Inh_Constructor) = + (let ( _lhsOself) = sem + in (Syn_Constructor _lhsOself)) +sem_Constructor_Constructor :: T_Range -> + T_Name -> + T_AnnotatedTypes -> + T_Constructor +sem_Constructor_Constructor range_ constructor_ types_ = + (let _lhsOself :: Constructor + _rangeIself :: Range + _constructorIself :: Name + _typesIself :: AnnotatedTypes + _self = + Constructor_Constructor _rangeIself _constructorIself _typesIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _constructorIself) = + constructor_ + ( _typesIself) = + types_ + in ( _lhsOself)) +sem_Constructor_Infix :: T_Range -> + T_AnnotatedType -> + T_Name -> + T_AnnotatedType -> + T_Constructor +sem_Constructor_Infix range_ leftType_ constructorOperator_ rightType_ = + (let _lhsOself :: Constructor + _rangeIself :: Range + _leftTypeIself :: AnnotatedType + _constructorOperatorIself :: Name + _rightTypeIself :: AnnotatedType + _self = + Constructor_Infix _rangeIself _leftTypeIself _constructorOperatorIself _rightTypeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _leftTypeIself) = + leftType_ + ( _constructorOperatorIself) = + constructorOperator_ + ( _rightTypeIself) = + rightType_ + in ( _lhsOself)) +sem_Constructor_Record :: T_Range -> + T_Name -> + T_FieldDeclarations -> + T_Constructor +sem_Constructor_Record range_ constructor_ fieldDeclarations_ = + (let _lhsOself :: Constructor + _rangeIself :: Range + _constructorIself :: Name + _fieldDeclarationsIself :: FieldDeclarations + _self = + Constructor_Record _rangeIself _constructorIself _fieldDeclarationsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _constructorIself) = + constructor_ + ( _fieldDeclarationsIself) = + fieldDeclarations_ + in ( _lhsOself)) +-- Constructors ------------------------------------------------ +-- cata +sem_Constructors :: Constructors -> + T_Constructors +sem_Constructors list = + (Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list)) +-- semantic domain +type T_Constructors = ( Constructors) +data Inh_Constructors = Inh_Constructors {} +data Syn_Constructors = Syn_Constructors {self_Syn_Constructors :: Constructors} +wrap_Constructors :: T_Constructors -> + Inh_Constructors -> + Syn_Constructors +wrap_Constructors sem (Inh_Constructors) = + (let ( _lhsOself) = sem + in (Syn_Constructors _lhsOself)) +sem_Constructors_Cons :: T_Constructor -> + T_Constructors -> + T_Constructors +sem_Constructors_Cons hd_ tl_ = + (let _lhsOself :: Constructors + _hdIself :: Constructor + _tlIself :: Constructors + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = + (let _lhsOself :: Constructors + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- ContextItem ------------------------------------------------- +-- cata +sem_ContextItem :: ContextItem -> + T_ContextItem +sem_ContextItem (ContextItem_ContextItem _range _name _types) = + (sem_ContextItem_ContextItem (sem_Range _range) (sem_Name _name) (sem_Types _types)) +-- semantic domain +type T_ContextItem = ( ContextItem) +data Inh_ContextItem = Inh_ContextItem {} +data Syn_ContextItem = Syn_ContextItem {self_Syn_ContextItem :: ContextItem} +wrap_ContextItem :: T_ContextItem -> + Inh_ContextItem -> + Syn_ContextItem +wrap_ContextItem sem (Inh_ContextItem) = + (let ( _lhsOself) = sem + in (Syn_ContextItem _lhsOself)) +sem_ContextItem_ContextItem :: T_Range -> + T_Name -> + T_Types -> + T_ContextItem +sem_ContextItem_ContextItem range_ name_ types_ = + (let _lhsOself :: ContextItem + _rangeIself :: Range + _nameIself :: Name + _typesIself :: Types + _typesItypevariables :: Names + _self = + ContextItem_ContextItem _rangeIself _nameIself _typesIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _typesIself,_typesItypevariables) = + types_ + in ( _lhsOself)) +-- ContextItems ------------------------------------------------ +-- cata +sem_ContextItems :: ContextItems -> + T_ContextItems +sem_ContextItems list = + (Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list)) +-- semantic domain +type T_ContextItems = ( ContextItems) +data Inh_ContextItems = Inh_ContextItems {} +data Syn_ContextItems = Syn_ContextItems {self_Syn_ContextItems :: ContextItems} +wrap_ContextItems :: T_ContextItems -> + Inh_ContextItems -> + Syn_ContextItems +wrap_ContextItems sem (Inh_ContextItems) = + (let ( _lhsOself) = sem + in (Syn_ContextItems _lhsOself)) +sem_ContextItems_Cons :: T_ContextItem -> + T_ContextItems -> + T_ContextItems +sem_ContextItems_Cons hd_ tl_ = + (let _lhsOself :: ContextItems + _hdIself :: ContextItem + _tlIself :: ContextItems + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = + (let _lhsOself :: ContextItems + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Declaration ------------------------------------------------- +-- cata +sem_Declaration :: Declaration -> + T_Declaration +sem_Declaration (Declaration_Hole _range _id) = + (sem_Declaration_Hole (sem_Range _range) _id) +sem_Declaration (Declaration_Type _range _simpletype _type) = + (sem_Declaration_Type (sem_Range _range) (sem_SimpleType _simpletype) (sem_Type _type)) +sem_Declaration (Declaration_Data _range _context _simpletype _constructors _derivings) = + (sem_Declaration_Data (sem_Range _range) (sem_ContextItems _context) (sem_SimpleType _simpletype) (sem_Constructors _constructors) (sem_Names _derivings)) +sem_Declaration (Declaration_Newtype _range _context _simpletype _constructor _derivings) = + (sem_Declaration_Newtype (sem_Range _range) (sem_ContextItems _context) (sem_SimpleType _simpletype) (sem_Constructor _constructor) (sem_Names _derivings)) +sem_Declaration (Declaration_Class _range _context _simpletype _where) = + (sem_Declaration_Class (sem_Range _range) (sem_ContextItems _context) (sem_SimpleType _simpletype) (sem_MaybeDeclarations _where)) +sem_Declaration (Declaration_Instance _range _context _name _types _where) = + (sem_Declaration_Instance (sem_Range _range) (sem_ContextItems _context) (sem_Name _name) (sem_Types _types) (sem_MaybeDeclarations _where)) +sem_Declaration (Declaration_Default _range _types) = + (sem_Declaration_Default (sem_Range _range) (sem_Types _types)) +sem_Declaration (Declaration_FunctionBindings _range _bindings) = + (sem_Declaration_FunctionBindings (sem_Range _range) (sem_FunctionBindings _bindings)) +sem_Declaration (Declaration_PatternBinding _range _pattern _righthandside) = + (sem_Declaration_PatternBinding (sem_Range _range) (sem_Pattern _pattern) (sem_RightHandSide _righthandside)) +sem_Declaration (Declaration_TypeSignature _range _names _type) = + (sem_Declaration_TypeSignature (sem_Range _range) (sem_Names _names) (sem_Type _type)) +sem_Declaration (Declaration_Fixity _range _fixity _priority _operators) = + (sem_Declaration_Fixity (sem_Range _range) (sem_Fixity _fixity) (sem_MaybeInt _priority) (sem_Names _operators)) +sem_Declaration (Declaration_Empty _range) = + (sem_Declaration_Empty (sem_Range _range)) +-- semantic domain +type T_Declaration = ( Declaration) +data Inh_Declaration = Inh_Declaration {} +data Syn_Declaration = Syn_Declaration {self_Syn_Declaration :: Declaration} +wrap_Declaration :: T_Declaration -> + Inh_Declaration -> + Syn_Declaration +wrap_Declaration sem (Inh_Declaration) = + (let ( _lhsOself) = sem + in (Syn_Declaration _lhsOself)) +sem_Declaration_Hole :: T_Range -> + Integer -> + T_Declaration +sem_Declaration_Hole range_ id_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _self = + Declaration_Hole _rangeIself id_ + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_Declaration_Type :: T_Range -> + T_SimpleType -> + T_Type -> + T_Declaration +sem_Declaration_Type range_ simpletype_ type_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _simpletypeIself :: SimpleType + _typeIself :: Type + _typeItypevariables :: Names + _self = + Declaration_Type _rangeIself _simpletypeIself _typeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _simpletypeIself) = + simpletype_ + ( _typeIself,_typeItypevariables) = + type_ + in ( _lhsOself)) +sem_Declaration_Data :: T_Range -> + T_ContextItems -> + T_SimpleType -> + T_Constructors -> + T_Names -> + T_Declaration +sem_Declaration_Data range_ context_ simpletype_ constructors_ derivings_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _contextIself :: ContextItems + _simpletypeIself :: SimpleType + _constructorsIself :: Constructors + _derivingsIself :: Names + _self = + Declaration_Data _rangeIself _contextIself _simpletypeIself _constructorsIself _derivingsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _contextIself) = + context_ + ( _simpletypeIself) = + simpletype_ + ( _constructorsIself) = + constructors_ + ( _derivingsIself) = + derivings_ + in ( _lhsOself)) +sem_Declaration_Newtype :: T_Range -> + T_ContextItems -> + T_SimpleType -> + T_Constructor -> + T_Names -> + T_Declaration +sem_Declaration_Newtype range_ context_ simpletype_ constructor_ derivings_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _contextIself :: ContextItems + _simpletypeIself :: SimpleType + _constructorIself :: Constructor + _derivingsIself :: Names + _self = + Declaration_Newtype _rangeIself _contextIself _simpletypeIself _constructorIself _derivingsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _contextIself) = + context_ + ( _simpletypeIself) = + simpletype_ + ( _constructorIself) = + constructor_ + ( _derivingsIself) = + derivings_ + in ( _lhsOself)) +sem_Declaration_Class :: T_Range -> + T_ContextItems -> + T_SimpleType -> + T_MaybeDeclarations -> + T_Declaration +sem_Declaration_Class range_ context_ simpletype_ where_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _contextIself :: ContextItems + _simpletypeIself :: SimpleType + _whereIself :: MaybeDeclarations + _self = + Declaration_Class _rangeIself _contextIself _simpletypeIself _whereIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _contextIself) = + context_ + ( _simpletypeIself) = + simpletype_ + ( _whereIself) = + where_ + in ( _lhsOself)) +sem_Declaration_Instance :: T_Range -> + T_ContextItems -> + T_Name -> + T_Types -> + T_MaybeDeclarations -> + T_Declaration +sem_Declaration_Instance range_ context_ name_ types_ where_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _contextIself :: ContextItems + _nameIself :: Name + _typesIself :: Types + _typesItypevariables :: Names + _whereIself :: MaybeDeclarations + _self = + Declaration_Instance _rangeIself _contextIself _nameIself _typesIself _whereIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _contextIself) = + context_ + ( _nameIself) = + name_ + ( _typesIself,_typesItypevariables) = + types_ + ( _whereIself) = + where_ + in ( _lhsOself)) +sem_Declaration_Default :: T_Range -> + T_Types -> + T_Declaration +sem_Declaration_Default range_ types_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _typesIself :: Types + _typesItypevariables :: Names + _self = + Declaration_Default _rangeIself _typesIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _typesIself,_typesItypevariables) = + types_ + in ( _lhsOself)) +sem_Declaration_FunctionBindings :: T_Range -> + T_FunctionBindings -> + T_Declaration +sem_Declaration_FunctionBindings range_ bindings_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _bindingsIself :: FunctionBindings + _self = + Declaration_FunctionBindings _rangeIself _bindingsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _bindingsIself) = + bindings_ + in ( _lhsOself)) +sem_Declaration_PatternBinding :: T_Range -> + T_Pattern -> + T_RightHandSide -> + T_Declaration +sem_Declaration_PatternBinding range_ pattern_ righthandside_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _patternIself :: Pattern + _righthandsideIself :: RightHandSide + _self = + Declaration_PatternBinding _rangeIself _patternIself _righthandsideIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _patternIself) = + pattern_ + ( _righthandsideIself) = + righthandside_ + in ( _lhsOself)) +sem_Declaration_TypeSignature :: T_Range -> + T_Names -> + T_Type -> + T_Declaration +sem_Declaration_TypeSignature range_ names_ type_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _namesIself :: Names + _typeIself :: Type + _typeItypevariables :: Names + _self = + Declaration_TypeSignature _rangeIself _namesIself _typeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _namesIself) = + names_ + ( _typeIself,_typeItypevariables) = + type_ + in ( _lhsOself)) +sem_Declaration_Fixity :: T_Range -> + T_Fixity -> + T_MaybeInt -> + T_Names -> + T_Declaration +sem_Declaration_Fixity range_ fixity_ priority_ operators_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _fixityIself :: Fixity + _priorityIself :: MaybeInt + _operatorsIself :: Names + _self = + Declaration_Fixity _rangeIself _fixityIself _priorityIself _operatorsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _fixityIself) = + fixity_ + ( _priorityIself) = + priority_ + ( _operatorsIself) = + operators_ + in ( _lhsOself)) +sem_Declaration_Empty :: T_Range -> + T_Declaration +sem_Declaration_Empty range_ = + (let _lhsOself :: Declaration + _rangeIself :: Range + _self = + Declaration_Empty _rangeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +-- Declarations ------------------------------------------------ +-- cata +sem_Declarations :: Declarations -> + T_Declarations +sem_Declarations list = + (Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list)) +-- semantic domain +type T_Declarations = ( Declarations) +data Inh_Declarations = Inh_Declarations {} +data Syn_Declarations = Syn_Declarations {self_Syn_Declarations :: Declarations} +wrap_Declarations :: T_Declarations -> + Inh_Declarations -> + Syn_Declarations +wrap_Declarations sem (Inh_Declarations) = + (let ( _lhsOself) = sem + in (Syn_Declarations _lhsOself)) +sem_Declarations_Cons :: T_Declaration -> + T_Declarations -> + T_Declarations +sem_Declarations_Cons hd_ tl_ = + (let _lhsOself :: Declarations + _hdIself :: Declaration + _tlIself :: Declarations + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = + (let _lhsOself :: Declarations + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Export ------------------------------------------------------ +-- cata +sem_Export :: Export -> + T_Export +sem_Export (Export_Variable _range _name) = + (sem_Export_Variable (sem_Range _range) (sem_Name _name)) +sem_Export (Export_TypeOrClass _range _name _names) = + (sem_Export_TypeOrClass (sem_Range _range) (sem_Name _name) (sem_MaybeNames _names)) +sem_Export (Export_TypeOrClassComplete _range _name) = + (sem_Export_TypeOrClassComplete (sem_Range _range) (sem_Name _name)) +sem_Export (Export_Module _range _name) = + (sem_Export_Module (sem_Range _range) (sem_Name _name)) +-- semantic domain +type T_Export = ( Export) +data Inh_Export = Inh_Export {} +data Syn_Export = Syn_Export {self_Syn_Export :: Export} +wrap_Export :: T_Export -> + Inh_Export -> + Syn_Export +wrap_Export sem (Inh_Export) = + (let ( _lhsOself) = sem + in (Syn_Export _lhsOself)) +sem_Export_Variable :: T_Range -> + T_Name -> + T_Export +sem_Export_Variable range_ name_ = + (let _lhsOself :: Export + _rangeIself :: Range + _nameIself :: Name + _self = + Export_Variable _rangeIself _nameIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + in ( _lhsOself)) +sem_Export_TypeOrClass :: T_Range -> + T_Name -> + T_MaybeNames -> + T_Export +sem_Export_TypeOrClass range_ name_ names_ = + (let _lhsOself :: Export + _rangeIself :: Range + _nameIself :: Name + _namesIself :: MaybeNames + _self = + Export_TypeOrClass _rangeIself _nameIself _namesIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _namesIself) = + names_ + in ( _lhsOself)) +sem_Export_TypeOrClassComplete :: T_Range -> + T_Name -> + T_Export +sem_Export_TypeOrClassComplete range_ name_ = + (let _lhsOself :: Export + _rangeIself :: Range + _nameIself :: Name + _self = + Export_TypeOrClassComplete _rangeIself _nameIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + in ( _lhsOself)) +sem_Export_Module :: T_Range -> + T_Name -> + T_Export +sem_Export_Module range_ name_ = + (let _lhsOself :: Export + _rangeIself :: Range + _nameIself :: Name + _self = + Export_Module _rangeIself _nameIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + in ( _lhsOself)) +-- Exports ----------------------------------------------------- +-- cata +sem_Exports :: Exports -> + T_Exports +sem_Exports list = + (Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list)) +-- semantic domain +type T_Exports = ( Exports) +data Inh_Exports = Inh_Exports {} +data Syn_Exports = Syn_Exports {self_Syn_Exports :: Exports} +wrap_Exports :: T_Exports -> + Inh_Exports -> + Syn_Exports +wrap_Exports sem (Inh_Exports) = + (let ( _lhsOself) = sem + in (Syn_Exports _lhsOself)) +sem_Exports_Cons :: T_Export -> + T_Exports -> + T_Exports +sem_Exports_Cons hd_ tl_ = + (let _lhsOself :: Exports + _hdIself :: Export + _tlIself :: Exports + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = + (let _lhsOself :: Exports + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Expression -------------------------------------------------- +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression_Hole _range _id) = + (sem_Expression_Hole (sem_Range _range) _id) +sem_Expression (Expression_Feedback _range _feedback _expression) = + (sem_Expression_Feedback (sem_Range _range) _feedback (sem_Expression _expression)) +sem_Expression (Expression_MustUse _range _expression) = + (sem_Expression_MustUse (sem_Range _range) (sem_Expression _expression)) +sem_Expression (Expression_Literal _range _literal) = + (sem_Expression_Literal (sem_Range _range) (sem_Literal _literal)) +sem_Expression (Expression_Variable _range _name) = + (sem_Expression_Variable (sem_Range _range) (sem_Name _name)) +sem_Expression (Expression_Constructor _range _name) = + (sem_Expression_Constructor (sem_Range _range) (sem_Name _name)) +sem_Expression (Expression_Parenthesized _range _expression) = + (sem_Expression_Parenthesized (sem_Range _range) (sem_Expression _expression)) +sem_Expression (Expression_NormalApplication _range _function _arguments) = + (sem_Expression_NormalApplication (sem_Range _range) (sem_Expression _function) (sem_Expressions _arguments)) +sem_Expression (Expression_InfixApplication _range _leftExpression _operator _rightExpression) = + (sem_Expression_InfixApplication (sem_Range _range) (sem_MaybeExpression _leftExpression) (sem_Expression _operator) (sem_MaybeExpression _rightExpression)) +sem_Expression (Expression_If _range _guardExpression _thenExpression _elseExpression) = + (sem_Expression_If (sem_Range _range) (sem_Expression _guardExpression) (sem_Expression _thenExpression) (sem_Expression _elseExpression)) +sem_Expression (Expression_Lambda _range _patterns _expression) = + (sem_Expression_Lambda (sem_Range _range) (sem_Patterns _patterns) (sem_Expression _expression)) +sem_Expression (Expression_Case _range _expression _alternatives) = + (sem_Expression_Case (sem_Range _range) (sem_Expression _expression) (sem_Alternatives _alternatives)) +sem_Expression (Expression_Let _range _declarations _expression) = + (sem_Expression_Let (sem_Range _range) (sem_Declarations _declarations) (sem_Expression _expression)) +sem_Expression (Expression_Do _range _statements) = + (sem_Expression_Do (sem_Range _range) (sem_Statements _statements)) +sem_Expression (Expression_List _range _expressions) = + (sem_Expression_List (sem_Range _range) (sem_Expressions _expressions)) +sem_Expression (Expression_Tuple _range _expressions) = + (sem_Expression_Tuple (sem_Range _range) (sem_Expressions _expressions)) +sem_Expression (Expression_Comprehension _range _expression _qualifiers) = + (sem_Expression_Comprehension (sem_Range _range) (sem_Expression _expression) (sem_Qualifiers _qualifiers)) +sem_Expression (Expression_Typed _range _expression _type) = + (sem_Expression_Typed (sem_Range _range) (sem_Expression _expression) (sem_Type _type)) +sem_Expression (Expression_RecordConstruction _range _name _recordExpressionBindings) = + (sem_Expression_RecordConstruction (sem_Range _range) (sem_Name _name) (sem_RecordExpressionBindings _recordExpressionBindings)) +sem_Expression (Expression_RecordUpdate _range _expression _recordExpressionBindings) = + (sem_Expression_RecordUpdate (sem_Range _range) (sem_Expression _expression) (sem_RecordExpressionBindings _recordExpressionBindings)) +sem_Expression (Expression_Enum _range _from _then _to) = + (sem_Expression_Enum (sem_Range _range) (sem_Expression _from) (sem_MaybeExpression _then) (sem_MaybeExpression _to)) +sem_Expression (Expression_Negate _range _expression) = + (sem_Expression_Negate (sem_Range _range) (sem_Expression _expression)) +sem_Expression (Expression_NegateFloat _range _expression) = + (sem_Expression_NegateFloat (sem_Range _range) (sem_Expression _expression)) +-- semantic domain +type T_Expression = ( Expression) +data Inh_Expression = Inh_Expression {} +data Syn_Expression = Syn_Expression {self_Syn_Expression :: Expression} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression sem (Inh_Expression) = + (let ( _lhsOself) = sem + in (Syn_Expression _lhsOself)) +sem_Expression_Hole :: T_Range -> + Integer -> + T_Expression +sem_Expression_Hole range_ id_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _self = + Expression_Hole _rangeIself id_ + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_Expression_Feedback :: T_Range -> + String -> + T_Expression -> + T_Expression +sem_Expression_Feedback range_ feedback_ expression_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _expressionIself :: Expression + _self = + Expression_Feedback _rangeIself feedback_ _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +sem_Expression_MustUse :: T_Range -> + T_Expression -> + T_Expression +sem_Expression_MustUse range_ expression_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _expressionIself :: Expression + _self = + Expression_MustUse _rangeIself _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +sem_Expression_Literal :: T_Range -> + T_Literal -> + T_Expression +sem_Expression_Literal range_ literal_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _literalIself :: Literal + _self = + Expression_Literal _rangeIself _literalIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _literalIself) = + literal_ + in ( _lhsOself)) +sem_Expression_Variable :: T_Range -> + T_Name -> + T_Expression +sem_Expression_Variable range_ name_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _nameIself :: Name + _self = + Expression_Variable _rangeIself _nameIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + in ( _lhsOself)) +sem_Expression_Constructor :: T_Range -> + T_Name -> + T_Expression +sem_Expression_Constructor range_ name_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _nameIself :: Name + _self = + Expression_Constructor _rangeIself _nameIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + in ( _lhsOself)) +sem_Expression_Parenthesized :: T_Range -> + T_Expression -> + T_Expression +sem_Expression_Parenthesized range_ expression_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _expressionIself :: Expression + _self = + Expression_Parenthesized _rangeIself _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +sem_Expression_NormalApplication :: T_Range -> + T_Expression -> + T_Expressions -> + T_Expression +sem_Expression_NormalApplication range_ function_ arguments_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _functionIself :: Expression + _argumentsIself :: Expressions + _self = + Expression_NormalApplication _rangeIself _functionIself _argumentsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _functionIself) = + function_ + ( _argumentsIself) = + arguments_ + in ( _lhsOself)) +sem_Expression_InfixApplication :: T_Range -> + T_MaybeExpression -> + T_Expression -> + T_MaybeExpression -> + T_Expression +sem_Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _leftExpressionIself :: MaybeExpression + _operatorIself :: Expression + _rightExpressionIself :: MaybeExpression + _self = + Expression_InfixApplication _rangeIself _leftExpressionIself _operatorIself _rightExpressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _leftExpressionIself) = + leftExpression_ + ( _operatorIself) = + operator_ + ( _rightExpressionIself) = + rightExpression_ + in ( _lhsOself)) +sem_Expression_If :: T_Range -> + T_Expression -> + T_Expression -> + T_Expression -> + T_Expression +sem_Expression_If range_ guardExpression_ thenExpression_ elseExpression_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _guardExpressionIself :: Expression + _thenExpressionIself :: Expression + _elseExpressionIself :: Expression + _self = + Expression_If _rangeIself _guardExpressionIself _thenExpressionIself _elseExpressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _guardExpressionIself) = + guardExpression_ + ( _thenExpressionIself) = + thenExpression_ + ( _elseExpressionIself) = + elseExpression_ + in ( _lhsOself)) +sem_Expression_Lambda :: T_Range -> + T_Patterns -> + T_Expression -> + T_Expression +sem_Expression_Lambda range_ patterns_ expression_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _patternsIself :: Patterns + _expressionIself :: Expression + _self = + Expression_Lambda _rangeIself _patternsIself _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _patternsIself) = + patterns_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +sem_Expression_Case :: T_Range -> + T_Expression -> + T_Alternatives -> + T_Expression +sem_Expression_Case range_ expression_ alternatives_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _expressionIself :: Expression + _alternativesIself :: Alternatives + _self = + Expression_Case _rangeIself _expressionIself _alternativesIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionIself) = + expression_ + ( _alternativesIself) = + alternatives_ + in ( _lhsOself)) +sem_Expression_Let :: T_Range -> + T_Declarations -> + T_Expression -> + T_Expression +sem_Expression_Let range_ declarations_ expression_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _declarationsIself :: Declarations + _expressionIself :: Expression + _self = + Expression_Let _rangeIself _declarationsIself _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _declarationsIself) = + declarations_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +sem_Expression_Do :: T_Range -> + T_Statements -> + T_Expression +sem_Expression_Do range_ statements_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _statementsIself :: Statements + _self = + Expression_Do _rangeIself _statementsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _statementsIself) = + statements_ + in ( _lhsOself)) +sem_Expression_List :: T_Range -> + T_Expressions -> + T_Expression +sem_Expression_List range_ expressions_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _expressionsIself :: Expressions + _self = + Expression_List _rangeIself _expressionsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionsIself) = + expressions_ + in ( _lhsOself)) +sem_Expression_Tuple :: T_Range -> + T_Expressions -> + T_Expression +sem_Expression_Tuple range_ expressions_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _expressionsIself :: Expressions + _self = + Expression_Tuple _rangeIself _expressionsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionsIself) = + expressions_ + in ( _lhsOself)) +sem_Expression_Comprehension :: T_Range -> + T_Expression -> + T_Qualifiers -> + T_Expression +sem_Expression_Comprehension range_ expression_ qualifiers_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _expressionIself :: Expression + _qualifiersIself :: Qualifiers + _self = + Expression_Comprehension _rangeIself _expressionIself _qualifiersIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionIself) = + expression_ + ( _qualifiersIself) = + qualifiers_ + in ( _lhsOself)) +sem_Expression_Typed :: T_Range -> + T_Expression -> + T_Type -> + T_Expression +sem_Expression_Typed range_ expression_ type_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _expressionIself :: Expression + _typeIself :: Type + _typeItypevariables :: Names + _self = + Expression_Typed _rangeIself _expressionIself _typeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionIself) = + expression_ + ( _typeIself,_typeItypevariables) = + type_ + in ( _lhsOself)) +sem_Expression_RecordConstruction :: T_Range -> + T_Name -> + T_RecordExpressionBindings -> + T_Expression +sem_Expression_RecordConstruction range_ name_ recordExpressionBindings_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _nameIself :: Name + _recordExpressionBindingsIself :: RecordExpressionBindings + _self = + Expression_RecordConstruction _rangeIself _nameIself _recordExpressionBindingsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _recordExpressionBindingsIself) = + recordExpressionBindings_ + in ( _lhsOself)) +sem_Expression_RecordUpdate :: T_Range -> + T_Expression -> + T_RecordExpressionBindings -> + T_Expression +sem_Expression_RecordUpdate range_ expression_ recordExpressionBindings_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _expressionIself :: Expression + _recordExpressionBindingsIself :: RecordExpressionBindings + _self = + Expression_RecordUpdate _rangeIself _expressionIself _recordExpressionBindingsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionIself) = + expression_ + ( _recordExpressionBindingsIself) = + recordExpressionBindings_ + in ( _lhsOself)) +sem_Expression_Enum :: T_Range -> + T_Expression -> + T_MaybeExpression -> + T_MaybeExpression -> + T_Expression +sem_Expression_Enum range_ from_ then_ to_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _fromIself :: Expression + _thenIself :: MaybeExpression + _toIself :: MaybeExpression + _self = + Expression_Enum _rangeIself _fromIself _thenIself _toIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _fromIself) = + from_ + ( _thenIself) = + then_ + ( _toIself) = + to_ + in ( _lhsOself)) +sem_Expression_Negate :: T_Range -> + T_Expression -> + T_Expression +sem_Expression_Negate range_ expression_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _expressionIself :: Expression + _self = + Expression_Negate _rangeIself _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +sem_Expression_NegateFloat :: T_Range -> + T_Expression -> + T_Expression +sem_Expression_NegateFloat range_ expression_ = + (let _lhsOself :: Expression + _rangeIself :: Range + _expressionIself :: Expression + _self = + Expression_NegateFloat _rangeIself _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +-- Expressions ------------------------------------------------- +-- cata +sem_Expressions :: Expressions -> + T_Expressions +sem_Expressions list = + (Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list)) +-- semantic domain +type T_Expressions = ( Expressions) +data Inh_Expressions = Inh_Expressions {} +data Syn_Expressions = Syn_Expressions {self_Syn_Expressions :: Expressions} +wrap_Expressions :: T_Expressions -> + Inh_Expressions -> + Syn_Expressions +wrap_Expressions sem (Inh_Expressions) = + (let ( _lhsOself) = sem + in (Syn_Expressions _lhsOself)) +sem_Expressions_Cons :: T_Expression -> + T_Expressions -> + T_Expressions +sem_Expressions_Cons hd_ tl_ = + (let _lhsOself :: Expressions + _hdIself :: Expression + _tlIself :: Expressions + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = + (let _lhsOself :: Expressions + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- FieldDeclaration -------------------------------------------- +-- cata +sem_FieldDeclaration :: FieldDeclaration -> + T_FieldDeclaration +sem_FieldDeclaration (FieldDeclaration_FieldDeclaration _range _names _type) = + (sem_FieldDeclaration_FieldDeclaration (sem_Range _range) (sem_Names _names) (sem_AnnotatedType _type)) +-- semantic domain +type T_FieldDeclaration = ( FieldDeclaration) +data Inh_FieldDeclaration = Inh_FieldDeclaration {} +data Syn_FieldDeclaration = Syn_FieldDeclaration {self_Syn_FieldDeclaration :: FieldDeclaration} +wrap_FieldDeclaration :: T_FieldDeclaration -> + Inh_FieldDeclaration -> + Syn_FieldDeclaration +wrap_FieldDeclaration sem (Inh_FieldDeclaration) = + (let ( _lhsOself) = sem + in (Syn_FieldDeclaration _lhsOself)) +sem_FieldDeclaration_FieldDeclaration :: T_Range -> + T_Names -> + T_AnnotatedType -> + T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration range_ names_ type_ = + (let _lhsOself :: FieldDeclaration + _rangeIself :: Range + _namesIself :: Names + _typeIself :: AnnotatedType + _self = + FieldDeclaration_FieldDeclaration _rangeIself _namesIself _typeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _namesIself) = + names_ + ( _typeIself) = + type_ + in ( _lhsOself)) +-- FieldDeclarations ------------------------------------------- +-- cata +sem_FieldDeclarations :: FieldDeclarations -> + T_FieldDeclarations +sem_FieldDeclarations list = + (Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list)) +-- semantic domain +type T_FieldDeclarations = ( FieldDeclarations) +data Inh_FieldDeclarations = Inh_FieldDeclarations {} +data Syn_FieldDeclarations = Syn_FieldDeclarations {self_Syn_FieldDeclarations :: FieldDeclarations} +wrap_FieldDeclarations :: T_FieldDeclarations -> + Inh_FieldDeclarations -> + Syn_FieldDeclarations +wrap_FieldDeclarations sem (Inh_FieldDeclarations) = + (let ( _lhsOself) = sem + in (Syn_FieldDeclarations _lhsOself)) +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> + T_FieldDeclarations -> + T_FieldDeclarations +sem_FieldDeclarations_Cons hd_ tl_ = + (let _lhsOself :: FieldDeclarations + _hdIself :: FieldDeclaration + _tlIself :: FieldDeclarations + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = + (let _lhsOself :: FieldDeclarations + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Fixity ------------------------------------------------------ +-- cata +sem_Fixity :: Fixity -> + T_Fixity +sem_Fixity (Fixity_Infixl _range) = + (sem_Fixity_Infixl (sem_Range _range)) +sem_Fixity (Fixity_Infixr _range) = + (sem_Fixity_Infixr (sem_Range _range)) +sem_Fixity (Fixity_Infix _range) = + (sem_Fixity_Infix (sem_Range _range)) +-- semantic domain +type T_Fixity = ( Fixity) +data Inh_Fixity = Inh_Fixity {} +data Syn_Fixity = Syn_Fixity {self_Syn_Fixity :: Fixity} +wrap_Fixity :: T_Fixity -> + Inh_Fixity -> + Syn_Fixity +wrap_Fixity sem (Inh_Fixity) = + (let ( _lhsOself) = sem + in (Syn_Fixity _lhsOself)) +sem_Fixity_Infixl :: T_Range -> + T_Fixity +sem_Fixity_Infixl range_ = + (let _lhsOself :: Fixity + _rangeIself :: Range + _self = + Fixity_Infixl _rangeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_Fixity_Infixr :: T_Range -> + T_Fixity +sem_Fixity_Infixr range_ = + (let _lhsOself :: Fixity + _rangeIself :: Range + _self = + Fixity_Infixr _rangeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_Fixity_Infix :: T_Range -> + T_Fixity +sem_Fixity_Infix range_ = + (let _lhsOself :: Fixity + _rangeIself :: Range + _self = + Fixity_Infix _rangeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +-- FunctionBinding --------------------------------------------- +-- cata +sem_FunctionBinding :: FunctionBinding -> + T_FunctionBinding +sem_FunctionBinding (FunctionBinding_Hole _range _id) = + (sem_FunctionBinding_Hole (sem_Range _range) _id) +sem_FunctionBinding (FunctionBinding_Feedback _range _feedback _functionBinding) = + (sem_FunctionBinding_Feedback (sem_Range _range) _feedback (sem_FunctionBinding _functionBinding)) +sem_FunctionBinding (FunctionBinding_FunctionBinding _range _lefthandside _righthandside) = + (sem_FunctionBinding_FunctionBinding (sem_Range _range) (sem_LeftHandSide _lefthandside) (sem_RightHandSide _righthandside)) +-- semantic domain +type T_FunctionBinding = ( FunctionBinding) +data Inh_FunctionBinding = Inh_FunctionBinding {} +data Syn_FunctionBinding = Syn_FunctionBinding {self_Syn_FunctionBinding :: FunctionBinding} +wrap_FunctionBinding :: T_FunctionBinding -> + Inh_FunctionBinding -> + Syn_FunctionBinding +wrap_FunctionBinding sem (Inh_FunctionBinding) = + (let ( _lhsOself) = sem + in (Syn_FunctionBinding _lhsOself)) +sem_FunctionBinding_Hole :: T_Range -> + Integer -> + T_FunctionBinding +sem_FunctionBinding_Hole range_ id_ = + (let _lhsOself :: FunctionBinding + _rangeIself :: Range + _self = + FunctionBinding_Hole _rangeIself id_ + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_FunctionBinding_Feedback :: T_Range -> + String -> + T_FunctionBinding -> + T_FunctionBinding +sem_FunctionBinding_Feedback range_ feedback_ functionBinding_ = + (let _lhsOself :: FunctionBinding + _rangeIself :: Range + _functionBindingIself :: FunctionBinding + _self = + FunctionBinding_Feedback _rangeIself feedback_ _functionBindingIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _functionBindingIself) = + functionBinding_ + in ( _lhsOself)) +sem_FunctionBinding_FunctionBinding :: T_Range -> + T_LeftHandSide -> + T_RightHandSide -> + T_FunctionBinding +sem_FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ = + (let _lhsOself :: FunctionBinding + _rangeIself :: Range + _lefthandsideIself :: LeftHandSide + _righthandsideIself :: RightHandSide + _self = + FunctionBinding_FunctionBinding _rangeIself _lefthandsideIself _righthandsideIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _lefthandsideIself) = + lefthandside_ + ( _righthandsideIself) = + righthandside_ + in ( _lhsOself)) +-- FunctionBindings -------------------------------------------- +-- cata +sem_FunctionBindings :: FunctionBindings -> + T_FunctionBindings +sem_FunctionBindings list = + (Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list)) +-- semantic domain +type T_FunctionBindings = ( FunctionBindings) +data Inh_FunctionBindings = Inh_FunctionBindings {} +data Syn_FunctionBindings = Syn_FunctionBindings {self_Syn_FunctionBindings :: FunctionBindings} +wrap_FunctionBindings :: T_FunctionBindings -> + Inh_FunctionBindings -> + Syn_FunctionBindings +wrap_FunctionBindings sem (Inh_FunctionBindings) = + (let ( _lhsOself) = sem + in (Syn_FunctionBindings _lhsOself)) +sem_FunctionBindings_Cons :: T_FunctionBinding -> + T_FunctionBindings -> + T_FunctionBindings +sem_FunctionBindings_Cons hd_ tl_ = + (let _lhsOself :: FunctionBindings + _hdIself :: FunctionBinding + _tlIself :: FunctionBindings + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = + (let _lhsOself :: FunctionBindings + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- GuardedExpression ------------------------------------------- +-- cata +sem_GuardedExpression :: GuardedExpression -> + T_GuardedExpression +sem_GuardedExpression (GuardedExpression_GuardedExpression _range _guard _expression) = + (sem_GuardedExpression_GuardedExpression (sem_Range _range) (sem_Expression _guard) (sem_Expression _expression)) +-- semantic domain +type T_GuardedExpression = ( GuardedExpression) +data Inh_GuardedExpression = Inh_GuardedExpression {} +data Syn_GuardedExpression = Syn_GuardedExpression {self_Syn_GuardedExpression :: GuardedExpression} +wrap_GuardedExpression :: T_GuardedExpression -> + Inh_GuardedExpression -> + Syn_GuardedExpression +wrap_GuardedExpression sem (Inh_GuardedExpression) = + (let ( _lhsOself) = sem + in (Syn_GuardedExpression _lhsOself)) +sem_GuardedExpression_GuardedExpression :: T_Range -> + T_Expression -> + T_Expression -> + T_GuardedExpression +sem_GuardedExpression_GuardedExpression range_ guard_ expression_ = + (let _lhsOself :: GuardedExpression + _rangeIself :: Range + _guardIself :: Expression + _expressionIself :: Expression + _self = + GuardedExpression_GuardedExpression _rangeIself _guardIself _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _guardIself) = + guard_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +-- GuardedExpressions ------------------------------------------ +-- cata +sem_GuardedExpressions :: GuardedExpressions -> + T_GuardedExpressions +sem_GuardedExpressions list = + (Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list)) +-- semantic domain +type T_GuardedExpressions = ( GuardedExpressions) +data Inh_GuardedExpressions = Inh_GuardedExpressions {} +data Syn_GuardedExpressions = Syn_GuardedExpressions {self_Syn_GuardedExpressions :: GuardedExpressions} +wrap_GuardedExpressions :: T_GuardedExpressions -> + Inh_GuardedExpressions -> + Syn_GuardedExpressions +wrap_GuardedExpressions sem (Inh_GuardedExpressions) = + (let ( _lhsOself) = sem + in (Syn_GuardedExpressions _lhsOself)) +sem_GuardedExpressions_Cons :: T_GuardedExpression -> + T_GuardedExpressions -> + T_GuardedExpressions +sem_GuardedExpressions_Cons hd_ tl_ = + (let _lhsOself :: GuardedExpressions + _hdIself :: GuardedExpression + _tlIself :: GuardedExpressions + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = + (let _lhsOself :: GuardedExpressions + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Import ------------------------------------------------------ +-- cata +sem_Import :: Import -> + T_Import +sem_Import (Import_Variable _range _name) = + (sem_Import_Variable (sem_Range _range) (sem_Name _name)) +sem_Import (Import_TypeOrClass _range _name _names) = + (sem_Import_TypeOrClass (sem_Range _range) (sem_Name _name) (sem_MaybeNames _names)) +sem_Import (Import_TypeOrClassComplete _range _name) = + (sem_Import_TypeOrClassComplete (sem_Range _range) (sem_Name _name)) +-- semantic domain +type T_Import = ( Import) +data Inh_Import = Inh_Import {} +data Syn_Import = Syn_Import {self_Syn_Import :: Import} +wrap_Import :: T_Import -> + Inh_Import -> + Syn_Import +wrap_Import sem (Inh_Import) = + (let ( _lhsOself) = sem + in (Syn_Import _lhsOself)) +sem_Import_Variable :: T_Range -> + T_Name -> + T_Import +sem_Import_Variable range_ name_ = + (let _lhsOself :: Import + _rangeIself :: Range + _nameIself :: Name + _self = + Import_Variable _rangeIself _nameIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + in ( _lhsOself)) +sem_Import_TypeOrClass :: T_Range -> + T_Name -> + T_MaybeNames -> + T_Import +sem_Import_TypeOrClass range_ name_ names_ = + (let _lhsOself :: Import + _rangeIself :: Range + _nameIself :: Name + _namesIself :: MaybeNames + _self = + Import_TypeOrClass _rangeIself _nameIself _namesIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _namesIself) = + names_ + in ( _lhsOself)) +sem_Import_TypeOrClassComplete :: T_Range -> + T_Name -> + T_Import +sem_Import_TypeOrClassComplete range_ name_ = + (let _lhsOself :: Import + _rangeIself :: Range + _nameIself :: Name + _self = + Import_TypeOrClassComplete _rangeIself _nameIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + in ( _lhsOself)) +-- ImportDeclaration ------------------------------------------- +-- cata +sem_ImportDeclaration :: ImportDeclaration -> + T_ImportDeclaration +sem_ImportDeclaration (ImportDeclaration_Import _range _qualified _name _asname _importspecification) = + (sem_ImportDeclaration_Import (sem_Range _range) _qualified (sem_Name _name) (sem_MaybeName _asname) (sem_MaybeImportSpecification _importspecification)) +sem_ImportDeclaration (ImportDeclaration_Empty _range) = + (sem_ImportDeclaration_Empty (sem_Range _range)) +-- semantic domain +type T_ImportDeclaration = ( ImportDeclaration) +data Inh_ImportDeclaration = Inh_ImportDeclaration {} +data Syn_ImportDeclaration = Syn_ImportDeclaration {self_Syn_ImportDeclaration :: ImportDeclaration} +wrap_ImportDeclaration :: T_ImportDeclaration -> + Inh_ImportDeclaration -> + Syn_ImportDeclaration +wrap_ImportDeclaration sem (Inh_ImportDeclaration) = + (let ( _lhsOself) = sem + in (Syn_ImportDeclaration _lhsOself)) +sem_ImportDeclaration_Import :: T_Range -> + Bool -> + T_Name -> + T_MaybeName -> + T_MaybeImportSpecification -> + T_ImportDeclaration +sem_ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ = + (let _lhsOself :: ImportDeclaration + _rangeIself :: Range + _nameIself :: Name + _asnameIself :: MaybeName + _importspecificationIself :: MaybeImportSpecification + _self = + ImportDeclaration_Import _rangeIself qualified_ _nameIself _asnameIself _importspecificationIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _asnameIself) = + asname_ + ( _importspecificationIself) = + importspecification_ + in ( _lhsOself)) +sem_ImportDeclaration_Empty :: T_Range -> + T_ImportDeclaration +sem_ImportDeclaration_Empty range_ = + (let _lhsOself :: ImportDeclaration + _rangeIself :: Range + _self = + ImportDeclaration_Empty _rangeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +-- ImportDeclarations ------------------------------------------ +-- cata +sem_ImportDeclarations :: ImportDeclarations -> + T_ImportDeclarations +sem_ImportDeclarations list = + (Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list)) +-- semantic domain +type T_ImportDeclarations = ( ImportDeclarations) +data Inh_ImportDeclarations = Inh_ImportDeclarations {} +data Syn_ImportDeclarations = Syn_ImportDeclarations {self_Syn_ImportDeclarations :: ImportDeclarations} +wrap_ImportDeclarations :: T_ImportDeclarations -> + Inh_ImportDeclarations -> + Syn_ImportDeclarations +wrap_ImportDeclarations sem (Inh_ImportDeclarations) = + (let ( _lhsOself) = sem + in (Syn_ImportDeclarations _lhsOself)) +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> + T_ImportDeclarations -> + T_ImportDeclarations +sem_ImportDeclarations_Cons hd_ tl_ = + (let _lhsOself :: ImportDeclarations + _hdIself :: ImportDeclaration + _tlIself :: ImportDeclarations + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = + (let _lhsOself :: ImportDeclarations + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- ImportSpecification ----------------------------------------- +-- cata +sem_ImportSpecification :: ImportSpecification -> + T_ImportSpecification +sem_ImportSpecification (ImportSpecification_Import _range _hiding _imports) = + (sem_ImportSpecification_Import (sem_Range _range) _hiding (sem_Imports _imports)) +-- semantic domain +type T_ImportSpecification = ( ImportSpecification) +data Inh_ImportSpecification = Inh_ImportSpecification {} +data Syn_ImportSpecification = Syn_ImportSpecification {self_Syn_ImportSpecification :: ImportSpecification} +wrap_ImportSpecification :: T_ImportSpecification -> + Inh_ImportSpecification -> + Syn_ImportSpecification +wrap_ImportSpecification sem (Inh_ImportSpecification) = + (let ( _lhsOself) = sem + in (Syn_ImportSpecification _lhsOself)) +sem_ImportSpecification_Import :: T_Range -> + Bool -> + T_Imports -> + T_ImportSpecification +sem_ImportSpecification_Import range_ hiding_ imports_ = + (let _lhsOself :: ImportSpecification + _rangeIself :: Range + _importsIself :: Imports + _self = + ImportSpecification_Import _rangeIself hiding_ _importsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _importsIself) = + imports_ + in ( _lhsOself)) +-- Imports ----------------------------------------------------- +-- cata +sem_Imports :: Imports -> + T_Imports +sem_Imports list = + (Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list)) +-- semantic domain +type T_Imports = ( Imports) +data Inh_Imports = Inh_Imports {} +data Syn_Imports = Syn_Imports {self_Syn_Imports :: Imports} +wrap_Imports :: T_Imports -> + Inh_Imports -> + Syn_Imports +wrap_Imports sem (Inh_Imports) = + (let ( _lhsOself) = sem + in (Syn_Imports _lhsOself)) +sem_Imports_Cons :: T_Import -> + T_Imports -> + T_Imports +sem_Imports_Cons hd_ tl_ = + (let _lhsOself :: Imports + _hdIself :: Import + _tlIself :: Imports + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = + (let _lhsOself :: Imports + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Judgement --------------------------------------------------- +-- cata +sem_Judgement :: Judgement -> + T_Judgement +sem_Judgement (Judgement_Judgement _expression _type) = + (sem_Judgement_Judgement (sem_Expression _expression) (sem_Type _type)) +-- semantic domain +type T_Judgement = ([(Name,Tp)]) -> + ( Tp,Core_Judgement,Judgement,Expression,Names) +data Inh_Judgement = Inh_Judgement {nameMap_Inh_Judgement :: ([(Name,Tp)])} +data Syn_Judgement = Syn_Judgement {conclusionType_Syn_Judgement :: Tp,core_Syn_Judgement :: Core_Judgement,self_Syn_Judgement :: Judgement,theExpression_Syn_Judgement :: Expression,typevariables_Syn_Judgement :: Names} +wrap_Judgement :: T_Judgement -> + Inh_Judgement -> + Syn_Judgement +wrap_Judgement sem (Inh_Judgement _lhsInameMap) = + (let ( _lhsOconclusionType,_lhsOcore,_lhsOself,_lhsOtheExpression,_lhsOtypevariables) = sem _lhsInameMap + in (Syn_Judgement _lhsOconclusionType _lhsOcore _lhsOself _lhsOtheExpression _lhsOtypevariables)) +sem_Judgement_Judgement :: T_Expression -> + T_Type -> + T_Judgement +sem_Judgement_Judgement expression_ type_ = + (\ _lhsInameMap -> + (let _lhsOcore :: Core_Judgement + _lhsOconclusionType :: Tp + _lhsOtheExpression :: Expression + _lhsOtypevariables :: Names + _lhsOself :: Judgement + _expressionIself :: Expression + _typeIself :: Type + _typeItypevariables :: Names + _lhsOcore = + Judgement (showOneLine 10000 $ UHA_OneLine.oneLineTree_Syn_Expression $ UHA_OneLine.wrap_Expression (UHA_OneLine.sem_Expression _expressionIself) UHA_OneLine.Inh_Expression) (makeTpFromType _lhsInameMap _typeIself) + _lhsOconclusionType = + makeTpFromType _lhsInameMap _typeIself + _lhsOtheExpression = + _expressionIself + _lhsOtypevariables = + _typeItypevariables + _self = + Judgement_Judgement _expressionIself _typeIself + _lhsOself = + _self + ( _expressionIself) = + expression_ + ( _typeIself,_typeItypevariables) = + type_ + in ( _lhsOconclusionType,_lhsOcore,_lhsOself,_lhsOtheExpression,_lhsOtypevariables))) +-- LeftHandSide ------------------------------------------------ +-- cata +sem_LeftHandSide :: LeftHandSide -> + T_LeftHandSide +sem_LeftHandSide (LeftHandSide_Function _range _name _patterns) = + (sem_LeftHandSide_Function (sem_Range _range) (sem_Name _name) (sem_Patterns _patterns)) +sem_LeftHandSide (LeftHandSide_Infix _range _leftPattern _operator _rightPattern) = + (sem_LeftHandSide_Infix (sem_Range _range) (sem_Pattern _leftPattern) (sem_Name _operator) (sem_Pattern _rightPattern)) +sem_LeftHandSide (LeftHandSide_Parenthesized _range _lefthandside _patterns) = + (sem_LeftHandSide_Parenthesized (sem_Range _range) (sem_LeftHandSide _lefthandside) (sem_Patterns _patterns)) +-- semantic domain +type T_LeftHandSide = ( LeftHandSide) +data Inh_LeftHandSide = Inh_LeftHandSide {} +data Syn_LeftHandSide = Syn_LeftHandSide {self_Syn_LeftHandSide :: LeftHandSide} +wrap_LeftHandSide :: T_LeftHandSide -> + Inh_LeftHandSide -> + Syn_LeftHandSide +wrap_LeftHandSide sem (Inh_LeftHandSide) = + (let ( _lhsOself) = sem + in (Syn_LeftHandSide _lhsOself)) +sem_LeftHandSide_Function :: T_Range -> + T_Name -> + T_Patterns -> + T_LeftHandSide +sem_LeftHandSide_Function range_ name_ patterns_ = + (let _lhsOself :: LeftHandSide + _rangeIself :: Range + _nameIself :: Name + _patternsIself :: Patterns + _self = + LeftHandSide_Function _rangeIself _nameIself _patternsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _patternsIself) = + patterns_ + in ( _lhsOself)) +sem_LeftHandSide_Infix :: T_Range -> + T_Pattern -> + T_Name -> + T_Pattern -> + T_LeftHandSide +sem_LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ = + (let _lhsOself :: LeftHandSide + _rangeIself :: Range + _leftPatternIself :: Pattern + _operatorIself :: Name + _rightPatternIself :: Pattern + _self = + LeftHandSide_Infix _rangeIself _leftPatternIself _operatorIself _rightPatternIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _leftPatternIself) = + leftPattern_ + ( _operatorIself) = + operator_ + ( _rightPatternIself) = + rightPattern_ + in ( _lhsOself)) +sem_LeftHandSide_Parenthesized :: T_Range -> + T_LeftHandSide -> + T_Patterns -> + T_LeftHandSide +sem_LeftHandSide_Parenthesized range_ lefthandside_ patterns_ = + (let _lhsOself :: LeftHandSide + _rangeIself :: Range + _lefthandsideIself :: LeftHandSide + _patternsIself :: Patterns + _self = + LeftHandSide_Parenthesized _rangeIself _lefthandsideIself _patternsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _lefthandsideIself) = + lefthandside_ + ( _patternsIself) = + patterns_ + in ( _lhsOself)) +-- Literal ----------------------------------------------------- +-- cata +sem_Literal :: Literal -> + T_Literal +sem_Literal (Literal_Int _range _value) = + (sem_Literal_Int (sem_Range _range) _value) +sem_Literal (Literal_Char _range _value) = + (sem_Literal_Char (sem_Range _range) _value) +sem_Literal (Literal_Float _range _value) = + (sem_Literal_Float (sem_Range _range) _value) +sem_Literal (Literal_String _range _value) = + (sem_Literal_String (sem_Range _range) _value) +-- semantic domain +type T_Literal = ( Literal) +data Inh_Literal = Inh_Literal {} +data Syn_Literal = Syn_Literal {self_Syn_Literal :: Literal} +wrap_Literal :: T_Literal -> + Inh_Literal -> + Syn_Literal +wrap_Literal sem (Inh_Literal) = + (let ( _lhsOself) = sem + in (Syn_Literal _lhsOself)) +sem_Literal_Int :: T_Range -> + String -> + T_Literal +sem_Literal_Int range_ value_ = + (let _lhsOself :: Literal + _rangeIself :: Range + _self = + Literal_Int _rangeIself value_ + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_Literal_Char :: T_Range -> + String -> + T_Literal +sem_Literal_Char range_ value_ = + (let _lhsOself :: Literal + _rangeIself :: Range + _self = + Literal_Char _rangeIself value_ + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_Literal_Float :: T_Range -> + String -> + T_Literal +sem_Literal_Float range_ value_ = + (let _lhsOself :: Literal + _rangeIself :: Range + _self = + Literal_Float _rangeIself value_ + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_Literal_String :: T_Range -> + String -> + T_Literal +sem_Literal_String range_ value_ = + (let _lhsOself :: Literal + _rangeIself :: Range + _self = + Literal_String _rangeIself value_ + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +-- MaybeDeclarations ------------------------------------------- +-- cata +sem_MaybeDeclarations :: MaybeDeclarations -> + T_MaybeDeclarations +sem_MaybeDeclarations (MaybeDeclarations_Nothing) = + (sem_MaybeDeclarations_Nothing) +sem_MaybeDeclarations (MaybeDeclarations_Just _declarations) = + (sem_MaybeDeclarations_Just (sem_Declarations _declarations)) +-- semantic domain +type T_MaybeDeclarations = ( MaybeDeclarations) +data Inh_MaybeDeclarations = Inh_MaybeDeclarations {} +data Syn_MaybeDeclarations = Syn_MaybeDeclarations {self_Syn_MaybeDeclarations :: MaybeDeclarations} +wrap_MaybeDeclarations :: T_MaybeDeclarations -> + Inh_MaybeDeclarations -> + Syn_MaybeDeclarations +wrap_MaybeDeclarations sem (Inh_MaybeDeclarations) = + (let ( _lhsOself) = sem + in (Syn_MaybeDeclarations _lhsOself)) +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = + (let _lhsOself :: MaybeDeclarations + _self = + MaybeDeclarations_Nothing + _lhsOself = + _self + in ( _lhsOself)) +sem_MaybeDeclarations_Just :: T_Declarations -> + T_MaybeDeclarations +sem_MaybeDeclarations_Just declarations_ = + (let _lhsOself :: MaybeDeclarations + _declarationsIself :: Declarations + _self = + MaybeDeclarations_Just _declarationsIself + _lhsOself = + _self + ( _declarationsIself) = + declarations_ + in ( _lhsOself)) +-- MaybeExports ------------------------------------------------ +-- cata +sem_MaybeExports :: MaybeExports -> + T_MaybeExports +sem_MaybeExports (MaybeExports_Nothing) = + (sem_MaybeExports_Nothing) +sem_MaybeExports (MaybeExports_Just _exports) = + (sem_MaybeExports_Just (sem_Exports _exports)) +-- semantic domain +type T_MaybeExports = ( MaybeExports) +data Inh_MaybeExports = Inh_MaybeExports {} +data Syn_MaybeExports = Syn_MaybeExports {self_Syn_MaybeExports :: MaybeExports} +wrap_MaybeExports :: T_MaybeExports -> + Inh_MaybeExports -> + Syn_MaybeExports +wrap_MaybeExports sem (Inh_MaybeExports) = + (let ( _lhsOself) = sem + in (Syn_MaybeExports _lhsOself)) +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = + (let _lhsOself :: MaybeExports + _self = + MaybeExports_Nothing + _lhsOself = + _self + in ( _lhsOself)) +sem_MaybeExports_Just :: T_Exports -> + T_MaybeExports +sem_MaybeExports_Just exports_ = + (let _lhsOself :: MaybeExports + _exportsIself :: Exports + _self = + MaybeExports_Just _exportsIself + _lhsOself = + _self + ( _exportsIself) = + exports_ + in ( _lhsOself)) +-- MaybeExpression --------------------------------------------- +-- cata +sem_MaybeExpression :: MaybeExpression -> + T_MaybeExpression +sem_MaybeExpression (MaybeExpression_Nothing) = + (sem_MaybeExpression_Nothing) +sem_MaybeExpression (MaybeExpression_Just _expression) = + (sem_MaybeExpression_Just (sem_Expression _expression)) +-- semantic domain +type T_MaybeExpression = ( MaybeExpression) +data Inh_MaybeExpression = Inh_MaybeExpression {} +data Syn_MaybeExpression = Syn_MaybeExpression {self_Syn_MaybeExpression :: MaybeExpression} +wrap_MaybeExpression :: T_MaybeExpression -> + Inh_MaybeExpression -> + Syn_MaybeExpression +wrap_MaybeExpression sem (Inh_MaybeExpression) = + (let ( _lhsOself) = sem + in (Syn_MaybeExpression _lhsOself)) +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = + (let _lhsOself :: MaybeExpression + _self = + MaybeExpression_Nothing + _lhsOself = + _self + in ( _lhsOself)) +sem_MaybeExpression_Just :: T_Expression -> + T_MaybeExpression +sem_MaybeExpression_Just expression_ = + (let _lhsOself :: MaybeExpression + _expressionIself :: Expression + _self = + MaybeExpression_Just _expressionIself + _lhsOself = + _self + ( _expressionIself) = + expression_ + in ( _lhsOself)) +-- MaybeImportSpecification ------------------------------------ +-- cata +sem_MaybeImportSpecification :: MaybeImportSpecification -> + T_MaybeImportSpecification +sem_MaybeImportSpecification (MaybeImportSpecification_Nothing) = + (sem_MaybeImportSpecification_Nothing) +sem_MaybeImportSpecification (MaybeImportSpecification_Just _importspecification) = + (sem_MaybeImportSpecification_Just (sem_ImportSpecification _importspecification)) +-- semantic domain +type T_MaybeImportSpecification = ( MaybeImportSpecification) +data Inh_MaybeImportSpecification = Inh_MaybeImportSpecification {} +data Syn_MaybeImportSpecification = Syn_MaybeImportSpecification {self_Syn_MaybeImportSpecification :: MaybeImportSpecification} +wrap_MaybeImportSpecification :: T_MaybeImportSpecification -> + Inh_MaybeImportSpecification -> + Syn_MaybeImportSpecification +wrap_MaybeImportSpecification sem (Inh_MaybeImportSpecification) = + (let ( _lhsOself) = sem + in (Syn_MaybeImportSpecification _lhsOself)) +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = + (let _lhsOself :: MaybeImportSpecification + _self = + MaybeImportSpecification_Nothing + _lhsOself = + _self + in ( _lhsOself)) +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> + T_MaybeImportSpecification +sem_MaybeImportSpecification_Just importspecification_ = + (let _lhsOself :: MaybeImportSpecification + _importspecificationIself :: ImportSpecification + _self = + MaybeImportSpecification_Just _importspecificationIself + _lhsOself = + _self + ( _importspecificationIself) = + importspecification_ + in ( _lhsOself)) +-- MaybeInt ---------------------------------------------------- +-- cata +sem_MaybeInt :: MaybeInt -> + T_MaybeInt +sem_MaybeInt (MaybeInt_Nothing) = + (sem_MaybeInt_Nothing) +sem_MaybeInt (MaybeInt_Just _int) = + (sem_MaybeInt_Just _int) +-- semantic domain +type T_MaybeInt = ( MaybeInt) +data Inh_MaybeInt = Inh_MaybeInt {} +data Syn_MaybeInt = Syn_MaybeInt {self_Syn_MaybeInt :: MaybeInt} +wrap_MaybeInt :: T_MaybeInt -> + Inh_MaybeInt -> + Syn_MaybeInt +wrap_MaybeInt sem (Inh_MaybeInt) = + (let ( _lhsOself) = sem + in (Syn_MaybeInt _lhsOself)) +sem_MaybeInt_Nothing :: T_MaybeInt +sem_MaybeInt_Nothing = + (let _lhsOself :: MaybeInt + _self = + MaybeInt_Nothing + _lhsOself = + _self + in ( _lhsOself)) +sem_MaybeInt_Just :: Int -> + T_MaybeInt +sem_MaybeInt_Just int_ = + (let _lhsOself :: MaybeInt + _self = + MaybeInt_Just int_ + _lhsOself = + _self + in ( _lhsOself)) +-- MaybeName --------------------------------------------------- +-- cata +sem_MaybeName :: MaybeName -> + T_MaybeName +sem_MaybeName (MaybeName_Nothing) = + (sem_MaybeName_Nothing) +sem_MaybeName (MaybeName_Just _name) = + (sem_MaybeName_Just (sem_Name _name)) +-- semantic domain +type T_MaybeName = ( MaybeName) +data Inh_MaybeName = Inh_MaybeName {} +data Syn_MaybeName = Syn_MaybeName {self_Syn_MaybeName :: MaybeName} +wrap_MaybeName :: T_MaybeName -> + Inh_MaybeName -> + Syn_MaybeName +wrap_MaybeName sem (Inh_MaybeName) = + (let ( _lhsOself) = sem + in (Syn_MaybeName _lhsOself)) +sem_MaybeName_Nothing :: T_MaybeName +sem_MaybeName_Nothing = + (let _lhsOself :: MaybeName + _self = + MaybeName_Nothing + _lhsOself = + _self + in ( _lhsOself)) +sem_MaybeName_Just :: T_Name -> + T_MaybeName +sem_MaybeName_Just name_ = + (let _lhsOself :: MaybeName + _nameIself :: Name + _self = + MaybeName_Just _nameIself + _lhsOself = + _self + ( _nameIself) = + name_ + in ( _lhsOself)) +-- MaybeNames -------------------------------------------------- +-- cata +sem_MaybeNames :: MaybeNames -> + T_MaybeNames +sem_MaybeNames (MaybeNames_Nothing) = + (sem_MaybeNames_Nothing) +sem_MaybeNames (MaybeNames_Just _names) = + (sem_MaybeNames_Just (sem_Names _names)) +-- semantic domain +type T_MaybeNames = ( MaybeNames) +data Inh_MaybeNames = Inh_MaybeNames {} +data Syn_MaybeNames = Syn_MaybeNames {self_Syn_MaybeNames :: MaybeNames} +wrap_MaybeNames :: T_MaybeNames -> + Inh_MaybeNames -> + Syn_MaybeNames +wrap_MaybeNames sem (Inh_MaybeNames) = + (let ( _lhsOself) = sem + in (Syn_MaybeNames _lhsOself)) +sem_MaybeNames_Nothing :: T_MaybeNames +sem_MaybeNames_Nothing = + (let _lhsOself :: MaybeNames + _self = + MaybeNames_Nothing + _lhsOself = + _self + in ( _lhsOself)) +sem_MaybeNames_Just :: T_Names -> + T_MaybeNames +sem_MaybeNames_Just names_ = + (let _lhsOself :: MaybeNames + _namesIself :: Names + _self = + MaybeNames_Just _namesIself + _lhsOself = + _self + ( _namesIself) = + names_ + in ( _lhsOself)) +-- Module ------------------------------------------------------ +-- cata +sem_Module :: Module -> + T_Module +sem_Module (Module_Module _range _name _exports _body) = + (sem_Module_Module (sem_Range _range) (sem_MaybeName _name) (sem_MaybeExports _exports) (sem_Body _body)) +-- semantic domain +type T_Module = ( Module) +data Inh_Module = Inh_Module {} +data Syn_Module = Syn_Module {self_Syn_Module :: Module} +wrap_Module :: T_Module -> + Inh_Module -> + Syn_Module +wrap_Module sem (Inh_Module) = + (let ( _lhsOself) = sem + in (Syn_Module _lhsOself)) +sem_Module_Module :: T_Range -> + T_MaybeName -> + T_MaybeExports -> + T_Body -> + T_Module +sem_Module_Module range_ name_ exports_ body_ = + (let _lhsOself :: Module + _rangeIself :: Range + _nameIself :: MaybeName + _exportsIself :: MaybeExports + _bodyIself :: Body + _self = + Module_Module _rangeIself _nameIself _exportsIself _bodyIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _exportsIself) = + exports_ + ( _bodyIself) = + body_ + in ( _lhsOself)) +-- Name -------------------------------------------------------- +-- cata +sem_Name :: Name -> + T_Name +sem_Name (Name_Identifier _range _module _name) = + (sem_Name_Identifier (sem_Range _range) (sem_Strings _module) _name) +sem_Name (Name_Operator _range _module _name) = + (sem_Name_Operator (sem_Range _range) (sem_Strings _module) _name) +sem_Name (Name_Special _range _module _name) = + (sem_Name_Special (sem_Range _range) (sem_Strings _module) _name) +-- semantic domain +type T_Name = ( Name) +data Inh_Name = Inh_Name {} +data Syn_Name = Syn_Name {self_Syn_Name :: Name} +wrap_Name :: T_Name -> + Inh_Name -> + Syn_Name +wrap_Name sem (Inh_Name) = + (let ( _lhsOself) = sem + in (Syn_Name _lhsOself)) +sem_Name_Identifier :: T_Range -> + T_Strings -> + String -> + T_Name +sem_Name_Identifier range_ module_ name_ = + (let _lhsOself :: Name + _rangeIself :: Range + _moduleIself :: Strings + _self = + Name_Identifier _rangeIself _moduleIself name_ + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _moduleIself) = + module_ + in ( _lhsOself)) +sem_Name_Operator :: T_Range -> + T_Strings -> + String -> + T_Name +sem_Name_Operator range_ module_ name_ = + (let _lhsOself :: Name + _rangeIself :: Range + _moduleIself :: Strings + _self = + Name_Operator _rangeIself _moduleIself name_ + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _moduleIself) = + module_ + in ( _lhsOself)) +sem_Name_Special :: T_Range -> + T_Strings -> + String -> + T_Name +sem_Name_Special range_ module_ name_ = + (let _lhsOself :: Name + _rangeIself :: Range + _moduleIself :: Strings + _self = + Name_Special _rangeIself _moduleIself name_ + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _moduleIself) = + module_ + in ( _lhsOself)) +-- Names ------------------------------------------------------- +-- cata +sem_Names :: Names -> + T_Names +sem_Names list = + (Prelude.foldr sem_Names_Cons sem_Names_Nil (Prelude.map sem_Name list)) +-- semantic domain +type T_Names = ( Names) +data Inh_Names = Inh_Names {} +data Syn_Names = Syn_Names {self_Syn_Names :: Names} +wrap_Names :: T_Names -> + Inh_Names -> + Syn_Names +wrap_Names sem (Inh_Names) = + (let ( _lhsOself) = sem + in (Syn_Names _lhsOself)) +sem_Names_Cons :: T_Name -> + T_Names -> + T_Names +sem_Names_Cons hd_ tl_ = + (let _lhsOself :: Names + _hdIself :: Name + _tlIself :: Names + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_Names_Nil :: T_Names +sem_Names_Nil = + (let _lhsOself :: Names + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Pattern ----------------------------------------------------- +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Pattern_Hole _range _id) = + (sem_Pattern_Hole (sem_Range _range) _id) +sem_Pattern (Pattern_Literal _range _literal) = + (sem_Pattern_Literal (sem_Range _range) (sem_Literal _literal)) +sem_Pattern (Pattern_Variable _range _name) = + (sem_Pattern_Variable (sem_Range _range) (sem_Name _name)) +sem_Pattern (Pattern_Constructor _range _name _patterns) = + (sem_Pattern_Constructor (sem_Range _range) (sem_Name _name) (sem_Patterns _patterns)) +sem_Pattern (Pattern_Parenthesized _range _pattern) = + (sem_Pattern_Parenthesized (sem_Range _range) (sem_Pattern _pattern)) +sem_Pattern (Pattern_InfixConstructor _range _leftPattern _constructorOperator _rightPattern) = + (sem_Pattern_InfixConstructor (sem_Range _range) (sem_Pattern _leftPattern) (sem_Name _constructorOperator) (sem_Pattern _rightPattern)) +sem_Pattern (Pattern_List _range _patterns) = + (sem_Pattern_List (sem_Range _range) (sem_Patterns _patterns)) +sem_Pattern (Pattern_Tuple _range _patterns) = + (sem_Pattern_Tuple (sem_Range _range) (sem_Patterns _patterns)) +sem_Pattern (Pattern_Record _range _name _recordPatternBindings) = + (sem_Pattern_Record (sem_Range _range) (sem_Name _name) (sem_RecordPatternBindings _recordPatternBindings)) +sem_Pattern (Pattern_Negate _range _literal) = + (sem_Pattern_Negate (sem_Range _range) (sem_Literal _literal)) +sem_Pattern (Pattern_As _range _name _pattern) = + (sem_Pattern_As (sem_Range _range) (sem_Name _name) (sem_Pattern _pattern)) +sem_Pattern (Pattern_Wildcard _range) = + (sem_Pattern_Wildcard (sem_Range _range)) +sem_Pattern (Pattern_Irrefutable _range _pattern) = + (sem_Pattern_Irrefutable (sem_Range _range) (sem_Pattern _pattern)) +sem_Pattern (Pattern_Successor _range _name _literal) = + (sem_Pattern_Successor (sem_Range _range) (sem_Name _name) (sem_Literal _literal)) +sem_Pattern (Pattern_NegateFloat _range _literal) = + (sem_Pattern_NegateFloat (sem_Range _range) (sem_Literal _literal)) +-- semantic domain +type T_Pattern = ( Pattern) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {self_Syn_Pattern :: Pattern} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern sem (Inh_Pattern) = + (let ( _lhsOself) = sem + in (Syn_Pattern _lhsOself)) +sem_Pattern_Hole :: T_Range -> + Integer -> + T_Pattern +sem_Pattern_Hole range_ id_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _self = + Pattern_Hole _rangeIself id_ + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_Pattern_Literal :: T_Range -> + T_Literal -> + T_Pattern +sem_Pattern_Literal range_ literal_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _literalIself :: Literal + _self = + Pattern_Literal _rangeIself _literalIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _literalIself) = + literal_ + in ( _lhsOself)) +sem_Pattern_Variable :: T_Range -> + T_Name -> + T_Pattern +sem_Pattern_Variable range_ name_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _nameIself :: Name + _self = + Pattern_Variable _rangeIself _nameIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + in ( _lhsOself)) +sem_Pattern_Constructor :: T_Range -> + T_Name -> + T_Patterns -> + T_Pattern +sem_Pattern_Constructor range_ name_ patterns_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _nameIself :: Name + _patternsIself :: Patterns + _self = + Pattern_Constructor _rangeIself _nameIself _patternsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _patternsIself) = + patterns_ + in ( _lhsOself)) +sem_Pattern_Parenthesized :: T_Range -> + T_Pattern -> + T_Pattern +sem_Pattern_Parenthesized range_ pattern_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _patternIself :: Pattern + _self = + Pattern_Parenthesized _rangeIself _patternIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _patternIself) = + pattern_ + in ( _lhsOself)) +sem_Pattern_InfixConstructor :: T_Range -> + T_Pattern -> + T_Name -> + T_Pattern -> + T_Pattern +sem_Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _leftPatternIself :: Pattern + _constructorOperatorIself :: Name + _rightPatternIself :: Pattern + _self = + Pattern_InfixConstructor _rangeIself _leftPatternIself _constructorOperatorIself _rightPatternIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _leftPatternIself) = + leftPattern_ + ( _constructorOperatorIself) = + constructorOperator_ + ( _rightPatternIself) = + rightPattern_ + in ( _lhsOself)) +sem_Pattern_List :: T_Range -> + T_Patterns -> + T_Pattern +sem_Pattern_List range_ patterns_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _patternsIself :: Patterns + _self = + Pattern_List _rangeIself _patternsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _patternsIself) = + patterns_ + in ( _lhsOself)) +sem_Pattern_Tuple :: T_Range -> + T_Patterns -> + T_Pattern +sem_Pattern_Tuple range_ patterns_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _patternsIself :: Patterns + _self = + Pattern_Tuple _rangeIself _patternsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _patternsIself) = + patterns_ + in ( _lhsOself)) +sem_Pattern_Record :: T_Range -> + T_Name -> + T_RecordPatternBindings -> + T_Pattern +sem_Pattern_Record range_ name_ recordPatternBindings_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _nameIself :: Name + _recordPatternBindingsIself :: RecordPatternBindings + _self = + Pattern_Record _rangeIself _nameIself _recordPatternBindingsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _recordPatternBindingsIself) = + recordPatternBindings_ + in ( _lhsOself)) +sem_Pattern_Negate :: T_Range -> + T_Literal -> + T_Pattern +sem_Pattern_Negate range_ literal_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _literalIself :: Literal + _self = + Pattern_Negate _rangeIself _literalIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _literalIself) = + literal_ + in ( _lhsOself)) +sem_Pattern_As :: T_Range -> + T_Name -> + T_Pattern -> + T_Pattern +sem_Pattern_As range_ name_ pattern_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _nameIself :: Name + _patternIself :: Pattern + _self = + Pattern_As _rangeIself _nameIself _patternIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _patternIself) = + pattern_ + in ( _lhsOself)) +sem_Pattern_Wildcard :: T_Range -> + T_Pattern +sem_Pattern_Wildcard range_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _self = + Pattern_Wildcard _rangeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +sem_Pattern_Irrefutable :: T_Range -> + T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable range_ pattern_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _patternIself :: Pattern + _self = + Pattern_Irrefutable _rangeIself _patternIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _patternIself) = + pattern_ + in ( _lhsOself)) +sem_Pattern_Successor :: T_Range -> + T_Name -> + T_Literal -> + T_Pattern +sem_Pattern_Successor range_ name_ literal_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _nameIself :: Name + _literalIself :: Literal + _self = + Pattern_Successor _rangeIself _nameIself _literalIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _literalIself) = + literal_ + in ( _lhsOself)) +sem_Pattern_NegateFloat :: T_Range -> + T_Literal -> + T_Pattern +sem_Pattern_NegateFloat range_ literal_ = + (let _lhsOself :: Pattern + _rangeIself :: Range + _literalIself :: Literal + _self = + Pattern_NegateFloat _rangeIself _literalIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _literalIself) = + literal_ + in ( _lhsOself)) +-- Patterns ---------------------------------------------------- +-- cata +sem_Patterns :: Patterns -> + T_Patterns +sem_Patterns list = + (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)) +-- semantic domain +type T_Patterns = ( Patterns) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {self_Syn_Patterns :: Patterns} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns sem (Inh_Patterns) = + (let ( _lhsOself) = sem + in (Syn_Patterns _lhsOself)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons hd_ tl_ = + (let _lhsOself :: Patterns + _hdIself :: Pattern + _tlIself :: Patterns + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (let _lhsOself :: Patterns + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Position ---------------------------------------------------- +-- cata +sem_Position :: Position -> + T_Position +sem_Position (Position_Position _filename _line _column) = + (sem_Position_Position _filename _line _column) +sem_Position (Position_Unknown) = + (sem_Position_Unknown) +-- semantic domain +type T_Position = ( Position) +data Inh_Position = Inh_Position {} +data Syn_Position = Syn_Position {self_Syn_Position :: Position} +wrap_Position :: T_Position -> + Inh_Position -> + Syn_Position +wrap_Position sem (Inh_Position) = + (let ( _lhsOself) = sem + in (Syn_Position _lhsOself)) +sem_Position_Position :: String -> + Int -> + Int -> + T_Position +sem_Position_Position filename_ line_ column_ = + (let _lhsOself :: Position + _self = + Position_Position filename_ line_ column_ + _lhsOself = + _self + in ( _lhsOself)) +sem_Position_Unknown :: T_Position +sem_Position_Unknown = + (let _lhsOself :: Position + _self = + Position_Unknown + _lhsOself = + _self + in ( _lhsOself)) +-- Qualifier --------------------------------------------------- +-- cata +sem_Qualifier :: Qualifier -> + T_Qualifier +sem_Qualifier (Qualifier_Guard _range _guard) = + (sem_Qualifier_Guard (sem_Range _range) (sem_Expression _guard)) +sem_Qualifier (Qualifier_Let _range _declarations) = + (sem_Qualifier_Let (sem_Range _range) (sem_Declarations _declarations)) +sem_Qualifier (Qualifier_Generator _range _pattern _expression) = + (sem_Qualifier_Generator (sem_Range _range) (sem_Pattern _pattern) (sem_Expression _expression)) +sem_Qualifier (Qualifier_Empty _range) = + (sem_Qualifier_Empty (sem_Range _range)) +-- semantic domain +type T_Qualifier = ( Qualifier) +data Inh_Qualifier = Inh_Qualifier {} +data Syn_Qualifier = Syn_Qualifier {self_Syn_Qualifier :: Qualifier} +wrap_Qualifier :: T_Qualifier -> + Inh_Qualifier -> + Syn_Qualifier +wrap_Qualifier sem (Inh_Qualifier) = + (let ( _lhsOself) = sem + in (Syn_Qualifier _lhsOself)) +sem_Qualifier_Guard :: T_Range -> + T_Expression -> + T_Qualifier +sem_Qualifier_Guard range_ guard_ = + (let _lhsOself :: Qualifier + _rangeIself :: Range + _guardIself :: Expression + _self = + Qualifier_Guard _rangeIself _guardIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _guardIself) = + guard_ + in ( _lhsOself)) +sem_Qualifier_Let :: T_Range -> + T_Declarations -> + T_Qualifier +sem_Qualifier_Let range_ declarations_ = + (let _lhsOself :: Qualifier + _rangeIself :: Range + _declarationsIself :: Declarations + _self = + Qualifier_Let _rangeIself _declarationsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _declarationsIself) = + declarations_ + in ( _lhsOself)) +sem_Qualifier_Generator :: T_Range -> + T_Pattern -> + T_Expression -> + T_Qualifier +sem_Qualifier_Generator range_ pattern_ expression_ = + (let _lhsOself :: Qualifier + _rangeIself :: Range + _patternIself :: Pattern + _expressionIself :: Expression + _self = + Qualifier_Generator _rangeIself _patternIself _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _patternIself) = + pattern_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +sem_Qualifier_Empty :: T_Range -> + T_Qualifier +sem_Qualifier_Empty range_ = + (let _lhsOself :: Qualifier + _rangeIself :: Range + _self = + Qualifier_Empty _rangeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +-- Qualifiers -------------------------------------------------- +-- cata +sem_Qualifiers :: Qualifiers -> + T_Qualifiers +sem_Qualifiers list = + (Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list)) +-- semantic domain +type T_Qualifiers = ( Qualifiers) +data Inh_Qualifiers = Inh_Qualifiers {} +data Syn_Qualifiers = Syn_Qualifiers {self_Syn_Qualifiers :: Qualifiers} +wrap_Qualifiers :: T_Qualifiers -> + Inh_Qualifiers -> + Syn_Qualifiers +wrap_Qualifiers sem (Inh_Qualifiers) = + (let ( _lhsOself) = sem + in (Syn_Qualifiers _lhsOself)) +sem_Qualifiers_Cons :: T_Qualifier -> + T_Qualifiers -> + T_Qualifiers +sem_Qualifiers_Cons hd_ tl_ = + (let _lhsOself :: Qualifiers + _hdIself :: Qualifier + _tlIself :: Qualifiers + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = + (let _lhsOself :: Qualifiers + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Range ------------------------------------------------------- +-- cata +sem_Range :: Range -> + T_Range +sem_Range (Range_Range _start _stop) = + (sem_Range_Range (sem_Position _start) (sem_Position _stop)) +-- semantic domain +type T_Range = ( Range) +data Inh_Range = Inh_Range {} +data Syn_Range = Syn_Range {self_Syn_Range :: Range} +wrap_Range :: T_Range -> + Inh_Range -> + Syn_Range +wrap_Range sem (Inh_Range) = + (let ( _lhsOself) = sem + in (Syn_Range _lhsOself)) +sem_Range_Range :: T_Position -> + T_Position -> + T_Range +sem_Range_Range start_ stop_ = + (let _lhsOself :: Range + _startIself :: Position + _stopIself :: Position + _self = + Range_Range _startIself _stopIself + _lhsOself = + _self + ( _startIself) = + start_ + ( _stopIself) = + stop_ + in ( _lhsOself)) +-- RecordExpressionBinding ------------------------------------- +-- cata +sem_RecordExpressionBinding :: RecordExpressionBinding -> + T_RecordExpressionBinding +sem_RecordExpressionBinding (RecordExpressionBinding_RecordExpressionBinding _range _name _expression) = + (sem_RecordExpressionBinding_RecordExpressionBinding (sem_Range _range) (sem_Name _name) (sem_Expression _expression)) +-- semantic domain +type T_RecordExpressionBinding = ( RecordExpressionBinding) +data Inh_RecordExpressionBinding = Inh_RecordExpressionBinding {} +data Syn_RecordExpressionBinding = Syn_RecordExpressionBinding {self_Syn_RecordExpressionBinding :: RecordExpressionBinding} +wrap_RecordExpressionBinding :: T_RecordExpressionBinding -> + Inh_RecordExpressionBinding -> + Syn_RecordExpressionBinding +wrap_RecordExpressionBinding sem (Inh_RecordExpressionBinding) = + (let ( _lhsOself) = sem + in (Syn_RecordExpressionBinding _lhsOself)) +sem_RecordExpressionBinding_RecordExpressionBinding :: T_Range -> + T_Name -> + T_Expression -> + T_RecordExpressionBinding +sem_RecordExpressionBinding_RecordExpressionBinding range_ name_ expression_ = + (let _lhsOself :: RecordExpressionBinding + _rangeIself :: Range + _nameIself :: Name + _expressionIself :: Expression + _self = + RecordExpressionBinding_RecordExpressionBinding _rangeIself _nameIself _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +-- RecordExpressionBindings ------------------------------------ +-- cata +sem_RecordExpressionBindings :: RecordExpressionBindings -> + T_RecordExpressionBindings +sem_RecordExpressionBindings list = + (Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list)) +-- semantic domain +type T_RecordExpressionBindings = ( RecordExpressionBindings) +data Inh_RecordExpressionBindings = Inh_RecordExpressionBindings {} +data Syn_RecordExpressionBindings = Syn_RecordExpressionBindings {self_Syn_RecordExpressionBindings :: RecordExpressionBindings} +wrap_RecordExpressionBindings :: T_RecordExpressionBindings -> + Inh_RecordExpressionBindings -> + Syn_RecordExpressionBindings +wrap_RecordExpressionBindings sem (Inh_RecordExpressionBindings) = + (let ( _lhsOself) = sem + in (Syn_RecordExpressionBindings _lhsOself)) +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> + T_RecordExpressionBindings -> + T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons hd_ tl_ = + (let _lhsOself :: RecordExpressionBindings + _hdIself :: RecordExpressionBinding + _tlIself :: RecordExpressionBindings + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = + (let _lhsOself :: RecordExpressionBindings + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- RecordPatternBinding ---------------------------------------- +-- cata +sem_RecordPatternBinding :: RecordPatternBinding -> + T_RecordPatternBinding +sem_RecordPatternBinding (RecordPatternBinding_RecordPatternBinding _range _name _pattern) = + (sem_RecordPatternBinding_RecordPatternBinding (sem_Range _range) (sem_Name _name) (sem_Pattern _pattern)) +-- semantic domain +type T_RecordPatternBinding = ( RecordPatternBinding) +data Inh_RecordPatternBinding = Inh_RecordPatternBinding {} +data Syn_RecordPatternBinding = Syn_RecordPatternBinding {self_Syn_RecordPatternBinding :: RecordPatternBinding} +wrap_RecordPatternBinding :: T_RecordPatternBinding -> + Inh_RecordPatternBinding -> + Syn_RecordPatternBinding +wrap_RecordPatternBinding sem (Inh_RecordPatternBinding) = + (let ( _lhsOself) = sem + in (Syn_RecordPatternBinding _lhsOself)) +sem_RecordPatternBinding_RecordPatternBinding :: T_Range -> + T_Name -> + T_Pattern -> + T_RecordPatternBinding +sem_RecordPatternBinding_RecordPatternBinding range_ name_ pattern_ = + (let _lhsOself :: RecordPatternBinding + _rangeIself :: Range + _nameIself :: Name + _patternIself :: Pattern + _self = + RecordPatternBinding_RecordPatternBinding _rangeIself _nameIself _patternIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _patternIself) = + pattern_ + in ( _lhsOself)) +-- RecordPatternBindings --------------------------------------- +-- cata +sem_RecordPatternBindings :: RecordPatternBindings -> + T_RecordPatternBindings +sem_RecordPatternBindings list = + (Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list)) +-- semantic domain +type T_RecordPatternBindings = ( RecordPatternBindings) +data Inh_RecordPatternBindings = Inh_RecordPatternBindings {} +data Syn_RecordPatternBindings = Syn_RecordPatternBindings {self_Syn_RecordPatternBindings :: RecordPatternBindings} +wrap_RecordPatternBindings :: T_RecordPatternBindings -> + Inh_RecordPatternBindings -> + Syn_RecordPatternBindings +wrap_RecordPatternBindings sem (Inh_RecordPatternBindings) = + (let ( _lhsOself) = sem + in (Syn_RecordPatternBindings _lhsOself)) +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> + T_RecordPatternBindings -> + T_RecordPatternBindings +sem_RecordPatternBindings_Cons hd_ tl_ = + (let _lhsOself :: RecordPatternBindings + _hdIself :: RecordPatternBinding + _tlIself :: RecordPatternBindings + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = + (let _lhsOself :: RecordPatternBindings + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- RightHandSide ----------------------------------------------- +-- cata +sem_RightHandSide :: RightHandSide -> + T_RightHandSide +sem_RightHandSide (RightHandSide_Expression _range _expression _where) = + (sem_RightHandSide_Expression (sem_Range _range) (sem_Expression _expression) (sem_MaybeDeclarations _where)) +sem_RightHandSide (RightHandSide_Guarded _range _guardedexpressions _where) = + (sem_RightHandSide_Guarded (sem_Range _range) (sem_GuardedExpressions _guardedexpressions) (sem_MaybeDeclarations _where)) +-- semantic domain +type T_RightHandSide = ( RightHandSide) +data Inh_RightHandSide = Inh_RightHandSide {} +data Syn_RightHandSide = Syn_RightHandSide {self_Syn_RightHandSide :: RightHandSide} +wrap_RightHandSide :: T_RightHandSide -> + Inh_RightHandSide -> + Syn_RightHandSide +wrap_RightHandSide sem (Inh_RightHandSide) = + (let ( _lhsOself) = sem + in (Syn_RightHandSide _lhsOself)) +sem_RightHandSide_Expression :: T_Range -> + T_Expression -> + T_MaybeDeclarations -> + T_RightHandSide +sem_RightHandSide_Expression range_ expression_ where_ = + (let _lhsOself :: RightHandSide + _rangeIself :: Range + _expressionIself :: Expression + _whereIself :: MaybeDeclarations + _self = + RightHandSide_Expression _rangeIself _expressionIself _whereIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionIself) = + expression_ + ( _whereIself) = + where_ + in ( _lhsOself)) +sem_RightHandSide_Guarded :: T_Range -> + T_GuardedExpressions -> + T_MaybeDeclarations -> + T_RightHandSide +sem_RightHandSide_Guarded range_ guardedexpressions_ where_ = + (let _lhsOself :: RightHandSide + _rangeIself :: Range + _guardedexpressionsIself :: GuardedExpressions + _whereIself :: MaybeDeclarations + _self = + RightHandSide_Guarded _rangeIself _guardedexpressionsIself _whereIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _guardedexpressionsIself) = + guardedexpressions_ + ( _whereIself) = + where_ + in ( _lhsOself)) +-- SimpleJudgement --------------------------------------------- +-- cata +sem_SimpleJudgement :: SimpleJudgement -> + T_SimpleJudgement +sem_SimpleJudgement (SimpleJudgement_SimpleJudgement _name _type) = + (sem_SimpleJudgement_SimpleJudgement (sem_Name _name) (sem_Type _type)) +-- semantic domain +type T_SimpleJudgement = ([(Name,Tp)]) -> + ([(String,Tp)]) -> + ( Core_Judgement,SimpleJudgement,([(String,Tp)]),Names) +data Inh_SimpleJudgement = Inh_SimpleJudgement {nameMap_Inh_SimpleJudgement :: ([(Name,Tp)]),simpleJudgements_Inh_SimpleJudgement :: ([(String,Tp)])} +data Syn_SimpleJudgement = Syn_SimpleJudgement {core_Syn_SimpleJudgement :: Core_Judgement,self_Syn_SimpleJudgement :: SimpleJudgement,simpleJudgements_Syn_SimpleJudgement :: ([(String,Tp)]),typevariables_Syn_SimpleJudgement :: Names} +wrap_SimpleJudgement :: T_SimpleJudgement -> + Inh_SimpleJudgement -> + Syn_SimpleJudgement +wrap_SimpleJudgement sem (Inh_SimpleJudgement _lhsInameMap _lhsIsimpleJudgements) = + (let ( _lhsOcore,_lhsOself,_lhsOsimpleJudgements,_lhsOtypevariables) = sem _lhsInameMap _lhsIsimpleJudgements + in (Syn_SimpleJudgement _lhsOcore _lhsOself _lhsOsimpleJudgements _lhsOtypevariables)) +sem_SimpleJudgement_SimpleJudgement :: T_Name -> + T_Type -> + T_SimpleJudgement +sem_SimpleJudgement_SimpleJudgement name_ type_ = + (\ _lhsInameMap + _lhsIsimpleJudgements -> + (let _lhsOcore :: Core_Judgement + _lhsOsimpleJudgements :: ([(String,Tp)]) + _lhsOtypevariables :: Names + _lhsOself :: SimpleJudgement + _nameIself :: Name + _typeIself :: Type + _typeItypevariables :: Names + _lhsOcore = + Judgement (show _nameIself) (makeTpFromType _lhsInameMap _typeIself) + _lhsOsimpleJudgements = + _newJudgement : _lhsIsimpleJudgements + _newJudgement = + (show _nameIself, makeTpFromType _lhsInameMap _typeIself) + _lhsOtypevariables = + _typeItypevariables + _self = + SimpleJudgement_SimpleJudgement _nameIself _typeIself + _lhsOself = + _self + ( _nameIself) = + name_ + ( _typeIself,_typeItypevariables) = + type_ + in ( _lhsOcore,_lhsOself,_lhsOsimpleJudgements,_lhsOtypevariables))) +-- SimpleJudgements -------------------------------------------- +-- cata +sem_SimpleJudgements :: SimpleJudgements -> + T_SimpleJudgements +sem_SimpleJudgements list = + (Prelude.foldr sem_SimpleJudgements_Cons sem_SimpleJudgements_Nil (Prelude.map sem_SimpleJudgement list)) +-- semantic domain +type T_SimpleJudgements = ([(Name,Tp)]) -> + ([(String,Tp)]) -> + ( Core_Judgements,SimpleJudgements,([(String,Tp)]),Names) +data Inh_SimpleJudgements = Inh_SimpleJudgements {nameMap_Inh_SimpleJudgements :: ([(Name,Tp)]),simpleJudgements_Inh_SimpleJudgements :: ([(String,Tp)])} +data Syn_SimpleJudgements = Syn_SimpleJudgements {core_Syn_SimpleJudgements :: Core_Judgements,self_Syn_SimpleJudgements :: SimpleJudgements,simpleJudgements_Syn_SimpleJudgements :: ([(String,Tp)]),typevariables_Syn_SimpleJudgements :: Names} +wrap_SimpleJudgements :: T_SimpleJudgements -> + Inh_SimpleJudgements -> + Syn_SimpleJudgements +wrap_SimpleJudgements sem (Inh_SimpleJudgements _lhsInameMap _lhsIsimpleJudgements) = + (let ( _lhsOcore,_lhsOself,_lhsOsimpleJudgements,_lhsOtypevariables) = sem _lhsInameMap _lhsIsimpleJudgements + in (Syn_SimpleJudgements _lhsOcore _lhsOself _lhsOsimpleJudgements _lhsOtypevariables)) +sem_SimpleJudgements_Cons :: T_SimpleJudgement -> + T_SimpleJudgements -> + T_SimpleJudgements +sem_SimpleJudgements_Cons hd_ tl_ = + (\ _lhsInameMap + _lhsIsimpleJudgements -> + (let _lhsOcore :: Core_Judgements + _lhsOtypevariables :: Names + _lhsOself :: SimpleJudgements + _lhsOsimpleJudgements :: ([(String,Tp)]) + _hdOnameMap :: ([(Name,Tp)]) + _hdOsimpleJudgements :: ([(String,Tp)]) + _tlOnameMap :: ([(Name,Tp)]) + _tlOsimpleJudgements :: ([(String,Tp)]) + _hdIcore :: Core_Judgement + _hdIself :: SimpleJudgement + _hdIsimpleJudgements :: ([(String,Tp)]) + _hdItypevariables :: Names + _tlIcore :: Core_Judgements + _tlIself :: SimpleJudgements + _tlIsimpleJudgements :: ([(String,Tp)]) + _tlItypevariables :: Names + _lhsOcore = + _hdIcore : _tlIcore + _lhsOtypevariables = + _hdItypevariables ++ _tlItypevariables + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + _lhsOsimpleJudgements = + _tlIsimpleJudgements + _hdOnameMap = + _lhsInameMap + _hdOsimpleJudgements = + _lhsIsimpleJudgements + _tlOnameMap = + _lhsInameMap + _tlOsimpleJudgements = + _hdIsimpleJudgements + ( _hdIcore,_hdIself,_hdIsimpleJudgements,_hdItypevariables) = + hd_ _hdOnameMap _hdOsimpleJudgements + ( _tlIcore,_tlIself,_tlIsimpleJudgements,_tlItypevariables) = + tl_ _tlOnameMap _tlOsimpleJudgements + in ( _lhsOcore,_lhsOself,_lhsOsimpleJudgements,_lhsOtypevariables))) +sem_SimpleJudgements_Nil :: T_SimpleJudgements +sem_SimpleJudgements_Nil = + (\ _lhsInameMap + _lhsIsimpleJudgements -> + (let _lhsOcore :: Core_Judgements + _lhsOtypevariables :: Names + _lhsOself :: SimpleJudgements + _lhsOsimpleJudgements :: ([(String,Tp)]) + _lhsOcore = + [] + _lhsOtypevariables = + [] + _self = + [] + _lhsOself = + _self + _lhsOsimpleJudgements = + _lhsIsimpleJudgements + in ( _lhsOcore,_lhsOself,_lhsOsimpleJudgements,_lhsOtypevariables))) +-- SimpleType -------------------------------------------------- +-- cata +sem_SimpleType :: SimpleType -> + T_SimpleType +sem_SimpleType (SimpleType_SimpleType _range _name _typevariables) = + (sem_SimpleType_SimpleType (sem_Range _range) (sem_Name _name) (sem_Names _typevariables)) +-- semantic domain +type T_SimpleType = ( SimpleType) +data Inh_SimpleType = Inh_SimpleType {} +data Syn_SimpleType = Syn_SimpleType {self_Syn_SimpleType :: SimpleType} +wrap_SimpleType :: T_SimpleType -> + Inh_SimpleType -> + Syn_SimpleType +wrap_SimpleType sem (Inh_SimpleType) = + (let ( _lhsOself) = sem + in (Syn_SimpleType _lhsOself)) +sem_SimpleType_SimpleType :: T_Range -> + T_Name -> + T_Names -> + T_SimpleType +sem_SimpleType_SimpleType range_ name_ typevariables_ = + (let _lhsOself :: SimpleType + _rangeIself :: Range + _nameIself :: Name + _typevariablesIself :: Names + _self = + SimpleType_SimpleType _rangeIself _nameIself _typevariablesIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + ( _typevariablesIself) = + typevariables_ + in ( _lhsOself)) +-- Statement --------------------------------------------------- +-- cata +sem_Statement :: Statement -> + T_Statement +sem_Statement (Statement_Expression _range _expression) = + (sem_Statement_Expression (sem_Range _range) (sem_Expression _expression)) +sem_Statement (Statement_Let _range _declarations) = + (sem_Statement_Let (sem_Range _range) (sem_Declarations _declarations)) +sem_Statement (Statement_Generator _range _pattern _expression) = + (sem_Statement_Generator (sem_Range _range) (sem_Pattern _pattern) (sem_Expression _expression)) +sem_Statement (Statement_Empty _range) = + (sem_Statement_Empty (sem_Range _range)) +-- semantic domain +type T_Statement = ( Statement) +data Inh_Statement = Inh_Statement {} +data Syn_Statement = Syn_Statement {self_Syn_Statement :: Statement} +wrap_Statement :: T_Statement -> + Inh_Statement -> + Syn_Statement +wrap_Statement sem (Inh_Statement) = + (let ( _lhsOself) = sem + in (Syn_Statement _lhsOself)) +sem_Statement_Expression :: T_Range -> + T_Expression -> + T_Statement +sem_Statement_Expression range_ expression_ = + (let _lhsOself :: Statement + _rangeIself :: Range + _expressionIself :: Expression + _self = + Statement_Expression _rangeIself _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +sem_Statement_Let :: T_Range -> + T_Declarations -> + T_Statement +sem_Statement_Let range_ declarations_ = + (let _lhsOself :: Statement + _rangeIself :: Range + _declarationsIself :: Declarations + _self = + Statement_Let _rangeIself _declarationsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _declarationsIself) = + declarations_ + in ( _lhsOself)) +sem_Statement_Generator :: T_Range -> + T_Pattern -> + T_Expression -> + T_Statement +sem_Statement_Generator range_ pattern_ expression_ = + (let _lhsOself :: Statement + _rangeIself :: Range + _patternIself :: Pattern + _expressionIself :: Expression + _self = + Statement_Generator _rangeIself _patternIself _expressionIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _patternIself) = + pattern_ + ( _expressionIself) = + expression_ + in ( _lhsOself)) +sem_Statement_Empty :: T_Range -> + T_Statement +sem_Statement_Empty range_ = + (let _lhsOself :: Statement + _rangeIself :: Range + _self = + Statement_Empty _rangeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + in ( _lhsOself)) +-- Statements -------------------------------------------------- +-- cata +sem_Statements :: Statements -> + T_Statements +sem_Statements list = + (Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list)) +-- semantic domain +type T_Statements = ( Statements) +data Inh_Statements = Inh_Statements {} +data Syn_Statements = Syn_Statements {self_Syn_Statements :: Statements} +wrap_Statements :: T_Statements -> + Inh_Statements -> + Syn_Statements +wrap_Statements sem (Inh_Statements) = + (let ( _lhsOself) = sem + in (Syn_Statements _lhsOself)) +sem_Statements_Cons :: T_Statement -> + T_Statements -> + T_Statements +sem_Statements_Cons hd_ tl_ = + (let _lhsOself :: Statements + _hdIself :: Statement + _tlIself :: Statements + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself) = + hd_ + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = + (let _lhsOself :: Statements + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Strings ----------------------------------------------------- +-- cata +sem_Strings :: Strings -> + T_Strings +sem_Strings list = + (Prelude.foldr sem_Strings_Cons sem_Strings_Nil list) +-- semantic domain +type T_Strings = ( Strings) +data Inh_Strings = Inh_Strings {} +data Syn_Strings = Syn_Strings {self_Syn_Strings :: Strings} +wrap_Strings :: T_Strings -> + Inh_Strings -> + Syn_Strings +wrap_Strings sem (Inh_Strings) = + (let ( _lhsOself) = sem + in (Syn_Strings _lhsOself)) +sem_Strings_Cons :: String -> + T_Strings -> + T_Strings +sem_Strings_Cons hd_ tl_ = + (let _lhsOself :: Strings + _tlIself :: Strings + _self = + (:) hd_ _tlIself + _lhsOself = + _self + ( _tlIself) = + tl_ + in ( _lhsOself)) +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = + (let _lhsOself :: Strings + _self = + [] + _lhsOself = + _self + in ( _lhsOself)) +-- Type -------------------------------------------------------- +-- cata +sem_Type :: Type -> + T_Type +sem_Type (Type_Application _range _prefix _function _arguments) = + (sem_Type_Application (sem_Range _range) _prefix (sem_Type _function) (sem_Types _arguments)) +sem_Type (Type_Variable _range _name) = + (sem_Type_Variable (sem_Range _range) (sem_Name _name)) +sem_Type (Type_Constructor _range _name) = + (sem_Type_Constructor (sem_Range _range) (sem_Name _name)) +sem_Type (Type_Qualified _range _context _type) = + (sem_Type_Qualified (sem_Range _range) (sem_ContextItems _context) (sem_Type _type)) +sem_Type (Type_Forall _range _typevariables _type) = + (sem_Type_Forall (sem_Range _range) (sem_Names _typevariables) (sem_Type _type)) +sem_Type (Type_Exists _range _typevariables _type) = + (sem_Type_Exists (sem_Range _range) (sem_Names _typevariables) (sem_Type _type)) +sem_Type (Type_Parenthesized _range _type) = + (sem_Type_Parenthesized (sem_Range _range) (sem_Type _type)) +-- semantic domain +type T_Type = ( Type,Names) +data Inh_Type = Inh_Type {} +data Syn_Type = Syn_Type {self_Syn_Type :: Type,typevariables_Syn_Type :: Names} +wrap_Type :: T_Type -> + Inh_Type -> + Syn_Type +wrap_Type sem (Inh_Type) = + (let ( _lhsOself,_lhsOtypevariables) = sem + in (Syn_Type _lhsOself _lhsOtypevariables)) +sem_Type_Application :: T_Range -> + Bool -> + T_Type -> + T_Types -> + T_Type +sem_Type_Application range_ prefix_ function_ arguments_ = + (let _lhsOtypevariables :: Names + _lhsOself :: Type + _rangeIself :: Range + _functionIself :: Type + _functionItypevariables :: Names + _argumentsIself :: Types + _argumentsItypevariables :: Names + _lhsOtypevariables = + _functionItypevariables ++ _argumentsItypevariables + _self = + Type_Application _rangeIself prefix_ _functionIself _argumentsIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _functionIself,_functionItypevariables) = + function_ + ( _argumentsIself,_argumentsItypevariables) = + arguments_ + in ( _lhsOself,_lhsOtypevariables)) +sem_Type_Variable :: T_Range -> + T_Name -> + T_Type +sem_Type_Variable range_ name_ = + (let _lhsOtypevariables :: Names + _lhsOself :: Type + _rangeIself :: Range + _nameIself :: Name + _lhsOtypevariables = + [ _nameIself ] + _self = + Type_Variable _rangeIself _nameIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + in ( _lhsOself,_lhsOtypevariables)) +sem_Type_Constructor :: T_Range -> + T_Name -> + T_Type +sem_Type_Constructor range_ name_ = + (let _lhsOtypevariables :: Names + _lhsOself :: Type + _rangeIself :: Range + _nameIself :: Name + _lhsOtypevariables = + [] + _self = + Type_Constructor _rangeIself _nameIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _nameIself) = + name_ + in ( _lhsOself,_lhsOtypevariables)) +sem_Type_Qualified :: T_Range -> + T_ContextItems -> + T_Type -> + T_Type +sem_Type_Qualified range_ context_ type_ = + (let _lhsOtypevariables :: Names + _lhsOself :: Type + _rangeIself :: Range + _contextIself :: ContextItems + _typeIself :: Type + _typeItypevariables :: Names + _lhsOtypevariables = + _typeItypevariables + _self = + Type_Qualified _rangeIself _contextIself _typeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _contextIself) = + context_ + ( _typeIself,_typeItypevariables) = + type_ + in ( _lhsOself,_lhsOtypevariables)) +sem_Type_Forall :: T_Range -> + T_Names -> + T_Type -> + T_Type +sem_Type_Forall range_ typevariables_ type_ = + (let _lhsOtypevariables :: Names + _lhsOself :: Type + _rangeIself :: Range + _typevariablesIself :: Names + _typeIself :: Type + _typeItypevariables :: Names + _lhsOtypevariables = + _typeItypevariables + _self = + Type_Forall _rangeIself _typevariablesIself _typeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _typevariablesIself) = + typevariables_ + ( _typeIself,_typeItypevariables) = + type_ + in ( _lhsOself,_lhsOtypevariables)) +sem_Type_Exists :: T_Range -> + T_Names -> + T_Type -> + T_Type +sem_Type_Exists range_ typevariables_ type_ = + (let _lhsOtypevariables :: Names + _lhsOself :: Type + _rangeIself :: Range + _typevariablesIself :: Names + _typeIself :: Type + _typeItypevariables :: Names + _lhsOtypevariables = + _typeItypevariables + _self = + Type_Exists _rangeIself _typevariablesIself _typeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _typevariablesIself) = + typevariables_ + ( _typeIself,_typeItypevariables) = + type_ + in ( _lhsOself,_lhsOtypevariables)) +sem_Type_Parenthesized :: T_Range -> + T_Type -> + T_Type +sem_Type_Parenthesized range_ type_ = + (let _lhsOtypevariables :: Names + _lhsOself :: Type + _rangeIself :: Range + _typeIself :: Type + _typeItypevariables :: Names + _lhsOtypevariables = + _typeItypevariables + _self = + Type_Parenthesized _rangeIself _typeIself + _lhsOself = + _self + ( _rangeIself) = + range_ + ( _typeIself,_typeItypevariables) = + type_ + in ( _lhsOself,_lhsOtypevariables)) +-- TypeRule ---------------------------------------------------- +-- cata +sem_TypeRule :: TypeRule -> + T_TypeRule +sem_TypeRule (TypeRule_TypeRule _premises _conclusion) = + (sem_TypeRule_TypeRule (sem_SimpleJudgements _premises) (sem_Judgement _conclusion)) +-- semantic domain +type T_TypeRule = ([(Name,Tp)]) -> + ([(String,Tp)]) -> + ( Expression,Tp,Core_TypeRule,TypeRule,([(String,Tp)]),Names) +data Inh_TypeRule = Inh_TypeRule {nameMap_Inh_TypeRule :: ([(Name,Tp)]),simpleJudgements_Inh_TypeRule :: ([(String,Tp)])} +data Syn_TypeRule = Syn_TypeRule {conclusionExpression_Syn_TypeRule :: Expression,conclusionType_Syn_TypeRule :: Tp,core_Syn_TypeRule :: Core_TypeRule,self_Syn_TypeRule :: TypeRule,simpleJudgements_Syn_TypeRule :: ([(String,Tp)]),typevariables_Syn_TypeRule :: Names} +wrap_TypeRule :: T_TypeRule -> + Inh_TypeRule -> + Syn_TypeRule +wrap_TypeRule sem (Inh_TypeRule _lhsInameMap _lhsIsimpleJudgements) = + (let ( _lhsOconclusionExpression,_lhsOconclusionType,_lhsOcore,_lhsOself,_lhsOsimpleJudgements,_lhsOtypevariables) = sem _lhsInameMap _lhsIsimpleJudgements + in (Syn_TypeRule _lhsOconclusionExpression _lhsOconclusionType _lhsOcore _lhsOself _lhsOsimpleJudgements _lhsOtypevariables)) +sem_TypeRule_TypeRule :: T_SimpleJudgements -> + T_Judgement -> + T_TypeRule +sem_TypeRule_TypeRule premises_ conclusion_ = + (\ _lhsInameMap + _lhsIsimpleJudgements -> + (let _lhsOcore :: Core_TypeRule + _lhsOconclusionExpression :: Expression + _lhsOtypevariables :: Names + _lhsOself :: TypeRule + _lhsOconclusionType :: Tp + _lhsOsimpleJudgements :: ([(String,Tp)]) + _premisesOnameMap :: ([(Name,Tp)]) + _premisesOsimpleJudgements :: ([(String,Tp)]) + _conclusionOnameMap :: ([(Name,Tp)]) + _premisesIcore :: Core_Judgements + _premisesIself :: SimpleJudgements + _premisesIsimpleJudgements :: ([(String,Tp)]) + _premisesItypevariables :: Names + _conclusionIconclusionType :: Tp + _conclusionIcore :: Core_Judgement + _conclusionIself :: Judgement + _conclusionItheExpression :: Expression + _conclusionItypevariables :: Names + _lhsOcore = + TypeRule _premisesIcore _conclusionIcore + _lhsOconclusionExpression = + _conclusionItheExpression + _lhsOtypevariables = + _premisesItypevariables ++ _conclusionItypevariables + _self = + TypeRule_TypeRule _premisesIself _conclusionIself + _lhsOself = + _self + _lhsOconclusionType = + _conclusionIconclusionType + _lhsOsimpleJudgements = + _premisesIsimpleJudgements + _premisesOnameMap = + _lhsInameMap + _premisesOsimpleJudgements = + _lhsIsimpleJudgements + _conclusionOnameMap = + _lhsInameMap + ( _premisesIcore,_premisesIself,_premisesIsimpleJudgements,_premisesItypevariables) = + premises_ _premisesOnameMap _premisesOsimpleJudgements + ( _conclusionIconclusionType,_conclusionIcore,_conclusionIself,_conclusionItheExpression,_conclusionItypevariables) = + conclusion_ _conclusionOnameMap + in ( _lhsOconclusionExpression,_lhsOconclusionType,_lhsOcore,_lhsOself,_lhsOsimpleJudgements,_lhsOtypevariables))) +-- Types ------------------------------------------------------- +-- cata +sem_Types :: Types -> + T_Types +sem_Types list = + (Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list)) +-- semantic domain +type T_Types = ( Types,Names) +data Inh_Types = Inh_Types {} +data Syn_Types = Syn_Types {self_Syn_Types :: Types,typevariables_Syn_Types :: Names} +wrap_Types :: T_Types -> + Inh_Types -> + Syn_Types +wrap_Types sem (Inh_Types) = + (let ( _lhsOself,_lhsOtypevariables) = sem + in (Syn_Types _lhsOself _lhsOtypevariables)) +sem_Types_Cons :: T_Type -> + T_Types -> + T_Types +sem_Types_Cons hd_ tl_ = + (let _lhsOtypevariables :: Names + _lhsOself :: Types + _hdIself :: Type + _hdItypevariables :: Names + _tlIself :: Types + _tlItypevariables :: Names + _lhsOtypevariables = + _hdItypevariables ++ _tlItypevariables + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + ( _hdIself,_hdItypevariables) = + hd_ + ( _tlIself,_tlItypevariables) = + tl_ + in ( _lhsOself,_lhsOtypevariables)) +sem_Types_Nil :: T_Types +sem_Types_Nil = + (let _lhsOtypevariables :: Names + _lhsOself :: Types + _lhsOtypevariables = + [] + _self = + [] + _lhsOself = + _self + in ( _lhsOself,_lhsOtypevariables)) +-- TypingStrategies -------------------------------------------- +-- cata +sem_TypingStrategies :: TypingStrategies -> + T_TypingStrategies +sem_TypingStrategies list = + (Prelude.foldr sem_TypingStrategies_Cons sem_TypingStrategies_Nil (Prelude.map sem_TypingStrategy list)) +-- semantic domain +type T_TypingStrategies = ImportEnvironment -> + ( TypingStrategies) +data Inh_TypingStrategies = Inh_TypingStrategies {importEnvironment_Inh_TypingStrategies :: ImportEnvironment} +data Syn_TypingStrategies = Syn_TypingStrategies {self_Syn_TypingStrategies :: TypingStrategies} +wrap_TypingStrategies :: T_TypingStrategies -> + Inh_TypingStrategies -> + Syn_TypingStrategies +wrap_TypingStrategies sem (Inh_TypingStrategies _lhsIimportEnvironment) = + (let ( _lhsOself) = sem _lhsIimportEnvironment + in (Syn_TypingStrategies _lhsOself)) +sem_TypingStrategies_Cons :: T_TypingStrategy -> + T_TypingStrategies -> + T_TypingStrategies +sem_TypingStrategies_Cons hd_ tl_ = + (\ _lhsIimportEnvironment -> + (let _lhsOself :: TypingStrategies + _hdOimportEnvironment :: ImportEnvironment + _tlOimportEnvironment :: ImportEnvironment + _hdIcore :: Core_TypingStrategy + _hdIself :: TypingStrategy + _tlIself :: TypingStrategies + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + _hdOimportEnvironment = + _lhsIimportEnvironment + _tlOimportEnvironment = + _lhsIimportEnvironment + ( _hdIcore,_hdIself) = + hd_ _hdOimportEnvironment + ( _tlIself) = + tl_ _tlOimportEnvironment + in ( _lhsOself))) +sem_TypingStrategies_Nil :: T_TypingStrategies +sem_TypingStrategies_Nil = + (\ _lhsIimportEnvironment -> + (let _lhsOself :: TypingStrategies + _self = + [] + _lhsOself = + _self + in ( _lhsOself))) +-- TypingStrategy ---------------------------------------------- +-- cata +sem_TypingStrategy :: TypingStrategy -> + T_TypingStrategy +sem_TypingStrategy (TypingStrategy_Siblings _names) = + (sem_TypingStrategy_Siblings (sem_Names _names)) +sem_TypingStrategy (TypingStrategy_TypingStrategy _typerule _statements) = + (sem_TypingStrategy_TypingStrategy (sem_TypeRule _typerule) (sem_UserStatements _statements)) +-- semantic domain +type T_TypingStrategy = ImportEnvironment -> + ( Core_TypingStrategy,TypingStrategy) +data Inh_TypingStrategy = Inh_TypingStrategy {importEnvironment_Inh_TypingStrategy :: ImportEnvironment} +data Syn_TypingStrategy = Syn_TypingStrategy {core_Syn_TypingStrategy :: Core_TypingStrategy,self_Syn_TypingStrategy :: TypingStrategy} +wrap_TypingStrategy :: T_TypingStrategy -> + Inh_TypingStrategy -> + Syn_TypingStrategy +wrap_TypingStrategy sem (Inh_TypingStrategy _lhsIimportEnvironment) = + (let ( _lhsOcore,_lhsOself) = sem _lhsIimportEnvironment + in (Syn_TypingStrategy _lhsOcore _lhsOself)) +sem_TypingStrategy_Siblings :: T_Names -> + T_TypingStrategy +sem_TypingStrategy_Siblings names_ = + (\ _lhsIimportEnvironment -> + (let _lhsOcore :: Core_TypingStrategy + _lhsOself :: TypingStrategy + _namesIself :: Names + _lhsOcore = + Siblings (map getNameName _namesIself) + _self = + TypingStrategy_Siblings _namesIself + _lhsOself = + _self + ( _namesIself) = + names_ + in ( _lhsOcore,_lhsOself))) +sem_TypingStrategy_TypingStrategy :: T_TypeRule -> + T_UserStatements -> + T_TypingStrategy +sem_TypingStrategy_TypingStrategy typerule_ statements_ = + (\ _lhsIimportEnvironment -> + (let _lhsOcore :: Core_TypingStrategy + _statementsOuserConstraints :: (TypeConstraints ConstraintInfo) + _statementsOuserPredicates :: Predicates + _typeruleOsimpleJudgements :: ([(String,Tp)]) + _statementsOmetaVariableConstraintNames :: Names + _lhsOself :: TypingStrategy + _typeruleOnameMap :: ([(Name,Tp)]) + _statementsOattributeTable :: ([((String, Maybe String), MessageBlock)]) + _statementsOnameMap :: ([(Name,Tp)]) + _statementsOstandardConstraintInfo :: ConstraintInfo + _typeruleIconclusionExpression :: Expression + _typeruleIconclusionType :: Tp + _typeruleIcore :: Core_TypeRule + _typeruleIself :: TypeRule + _typeruleIsimpleJudgements :: ([(String,Tp)]) + _typeruleItypevariables :: Names + _statementsIcore :: Core_UserStatements + _statementsImetaVariableConstraintNames :: Names + _statementsIself :: UserStatements + _statementsItypevariables :: Names + _statementsIuserConstraints :: (TypeConstraints ConstraintInfo) + _statementsIuserPredicates :: Predicates + _lhsOcore = + TypingStrategy _typeEnv _typeruleIcore _statementsIcore + _nameMap = + zip _uniqueTypevariables (map TVar [0..]) + _typeEnv = + let newEnvironment = + let list = [ (nameFromString s, toTpScheme $ freezeVariablesInType tp) + | (s, tp) <- ("$$conclusion", _typeruleIconclusionType) : _typeruleIsimpleJudgements + ] + in _lhsIimportEnvironment { typeEnvironment = M.fromList list } + (inferredType, freeVariables, _) = expressionTypeInferencer newEnvironment _typeruleIconclusionExpression + monoType = unqualify (unquantify inferredType) + synonyms = getOrderedTypeSynonyms _lhsIimportEnvironment + sub = case mguWithTypeSynonyms synonyms monoType (freezeVariablesInType _typeruleIconclusionType) of + Left _ -> internalError "TS_ToCore.ag" "n/a" "no unification possible" + Right (_, s) -> s + in [ (show name, unfreezeVariablesInType (sub |-> tp)) + | (name, tp) <- concat (M.elems freeVariables) + ] + _uniqueTypevariables = + nub (_typeruleItypevariables ++ _statementsItypevariables) + _statementsOuserConstraints = + [] + _statementsOuserPredicates = + [] + _typeruleOsimpleJudgements = + [] + _statementsOmetaVariableConstraintNames = + [] + _allMetaVariables = + map fst _typeruleIsimpleJudgements + _constraintsNotExplicit = + filter (`notElem` (map show _statementsImetaVariableConstraintNames)) _allMetaVariables + _standardConstraintInfo = + standardConstraintInfo + _attributeTable = + [] + _self = + TypingStrategy_TypingStrategy _typeruleIself _statementsIself + _lhsOself = + _self + _typeruleOnameMap = + _nameMap + _statementsOattributeTable = + _attributeTable + _statementsOnameMap = + _nameMap + _statementsOstandardConstraintInfo = + _standardConstraintInfo + ( _typeruleIconclusionExpression,_typeruleIconclusionType,_typeruleIcore,_typeruleIself,_typeruleIsimpleJudgements,_typeruleItypevariables) = + typerule_ _typeruleOnameMap _typeruleOsimpleJudgements + ( _statementsIcore,_statementsImetaVariableConstraintNames,_statementsIself,_statementsItypevariables,_statementsIuserConstraints,_statementsIuserPredicates) = + statements_ _statementsOattributeTable _statementsOmetaVariableConstraintNames _statementsOnameMap _statementsOstandardConstraintInfo _statementsOuserConstraints _statementsOuserPredicates + in ( _lhsOcore,_lhsOself))) +-- UserStatement ----------------------------------------------- +-- cata +sem_UserStatement :: UserStatement -> + T_UserStatement +sem_UserStatement (UserStatement_Equal _leftType _rightType _message) = + (sem_UserStatement_Equal (sem_Type _leftType) (sem_Type _rightType) _message) +sem_UserStatement (UserStatement_Pred _predClass _predType _message) = + (sem_UserStatement_Pred (sem_Name _predClass) (sem_Type _predType) _message) +sem_UserStatement (UserStatement_MetaVariableConstraints _name) = + (sem_UserStatement_MetaVariableConstraints (sem_Name _name)) +sem_UserStatement (UserStatement_Phase _phase) = + (sem_UserStatement_Phase _phase) +-- semantic domain +type T_UserStatement = ([((String, Maybe String), MessageBlock)]) -> + Names -> + ([(Name,Tp)]) -> + ConstraintInfo -> + (TypeConstraints ConstraintInfo) -> + Predicates -> + ( Core_UserStatement,Names,UserStatement,Names,(TypeConstraints ConstraintInfo),Predicates) +data Inh_UserStatement = Inh_UserStatement {attributeTable_Inh_UserStatement :: ([((String, Maybe String), MessageBlock)]),metaVariableConstraintNames_Inh_UserStatement :: Names,nameMap_Inh_UserStatement :: ([(Name,Tp)]),standardConstraintInfo_Inh_UserStatement :: ConstraintInfo,userConstraints_Inh_UserStatement :: (TypeConstraints ConstraintInfo),userPredicates_Inh_UserStatement :: Predicates} +data Syn_UserStatement = Syn_UserStatement {core_Syn_UserStatement :: Core_UserStatement,metaVariableConstraintNames_Syn_UserStatement :: Names,self_Syn_UserStatement :: UserStatement,typevariables_Syn_UserStatement :: Names,userConstraints_Syn_UserStatement :: (TypeConstraints ConstraintInfo),userPredicates_Syn_UserStatement :: Predicates} +wrap_UserStatement :: T_UserStatement -> + Inh_UserStatement -> + Syn_UserStatement +wrap_UserStatement sem (Inh_UserStatement _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates) = + (let ( _lhsOcore,_lhsOmetaVariableConstraintNames,_lhsOself,_lhsOtypevariables,_lhsOuserConstraints,_lhsOuserPredicates) = sem _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates + in (Syn_UserStatement _lhsOcore _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates)) +sem_UserStatement_Equal :: T_Type -> + T_Type -> + String -> + T_UserStatement +sem_UserStatement_Equal leftType_ rightType_ message_ = + (\ _lhsIattributeTable + _lhsImetaVariableConstraintNames + _lhsInameMap + _lhsIstandardConstraintInfo + _lhsIuserConstraints + _lhsIuserPredicates -> + (let _lhsOcore :: Core_UserStatement + _lhsOuserConstraints :: (TypeConstraints ConstraintInfo) + _lhsOtypevariables :: Names + _lhsOself :: UserStatement + _lhsOmetaVariableConstraintNames :: Names + _lhsOuserPredicates :: Predicates + _leftTypeIself :: Type + _leftTypeItypevariables :: Names + _rightTypeIself :: Type + _rightTypeItypevariables :: Names + _lhsOcore = + Equal + (makeTpFromType _lhsInameMap _leftTypeIself) + (makeTpFromType _lhsInameMap _rightTypeIself) + (changeAttributes (useNameMap _lhsInameMap) message_) + _lhsOuserConstraints = + _newConstraint : _lhsIuserConstraints + _newConstraint = + (makeTpFromType _lhsInameMap _leftTypeIself .==. makeTpFromType _lhsInameMap _rightTypeIself) _lhsIstandardConstraintInfo + _lhsOtypevariables = + _leftTypeItypevariables ++ _rightTypeItypevariables + _self = + UserStatement_Equal _leftTypeIself _rightTypeIself message_ + _lhsOself = + _self + _lhsOmetaVariableConstraintNames = + _lhsImetaVariableConstraintNames + _lhsOuserPredicates = + _lhsIuserPredicates + ( _leftTypeIself,_leftTypeItypevariables) = + leftType_ + ( _rightTypeIself,_rightTypeItypevariables) = + rightType_ + in ( _lhsOcore,_lhsOmetaVariableConstraintNames,_lhsOself,_lhsOtypevariables,_lhsOuserConstraints,_lhsOuserPredicates))) +sem_UserStatement_Pred :: T_Name -> + T_Type -> + String -> + T_UserStatement +sem_UserStatement_Pred predClass_ predType_ message_ = + (\ _lhsIattributeTable + _lhsImetaVariableConstraintNames + _lhsInameMap + _lhsIstandardConstraintInfo + _lhsIuserConstraints + _lhsIuserPredicates -> + (let _lhsOcore :: Core_UserStatement + _lhsOuserPredicates :: Predicates + _lhsOtypevariables :: Names + _lhsOself :: UserStatement + _lhsOmetaVariableConstraintNames :: Names + _lhsOuserConstraints :: (TypeConstraints ConstraintInfo) + _predClassIself :: Name + _predTypeIself :: Type + _predTypeItypevariables :: Names + _lhsOcore = + Pred + (show _predClassIself) + (makeTpFromType _lhsInameMap _predTypeIself) + (changeAttributes (useNameMap _lhsInameMap) message_) + _lhsOuserPredicates = + _newPredicate : _lhsIuserPredicates + _newPredicate = + Predicate (show _predClassIself) (makeTpFromType _lhsInameMap _predTypeIself) + _lhsOtypevariables = + _predTypeItypevariables + _self = + UserStatement_Pred _predClassIself _predTypeIself message_ + _lhsOself = + _self + _lhsOmetaVariableConstraintNames = + _lhsImetaVariableConstraintNames + _lhsOuserConstraints = + _lhsIuserConstraints + ( _predClassIself) = + predClass_ + ( _predTypeIself,_predTypeItypevariables) = + predType_ + in ( _lhsOcore,_lhsOmetaVariableConstraintNames,_lhsOself,_lhsOtypevariables,_lhsOuserConstraints,_lhsOuserPredicates))) +sem_UserStatement_MetaVariableConstraints :: T_Name -> + T_UserStatement +sem_UserStatement_MetaVariableConstraints name_ = + (\ _lhsIattributeTable + _lhsImetaVariableConstraintNames + _lhsInameMap + _lhsIstandardConstraintInfo + _lhsIuserConstraints + _lhsIuserPredicates -> + (let _lhsOcore :: Core_UserStatement + _lhsOmetaVariableConstraintNames :: Names + _lhsOtypevariables :: Names + _lhsOself :: UserStatement + _lhsOuserConstraints :: (TypeConstraints ConstraintInfo) + _lhsOuserPredicates :: Predicates + _nameIself :: Name + _lhsOcore = + MetaVariableConstraints (show _nameIself) + _lhsOmetaVariableConstraintNames = + _nameIself : _lhsImetaVariableConstraintNames + _lhsOtypevariables = + [] + _self = + UserStatement_MetaVariableConstraints _nameIself + _lhsOself = + _self + _lhsOuserConstraints = + _lhsIuserConstraints + _lhsOuserPredicates = + _lhsIuserPredicates + ( _nameIself) = + name_ + in ( _lhsOcore,_lhsOmetaVariableConstraintNames,_lhsOself,_lhsOtypevariables,_lhsOuserConstraints,_lhsOuserPredicates))) +sem_UserStatement_Phase :: Int -> + T_UserStatement +sem_UserStatement_Phase phase_ = + (\ _lhsIattributeTable + _lhsImetaVariableConstraintNames + _lhsInameMap + _lhsIstandardConstraintInfo + _lhsIuserConstraints + _lhsIuserPredicates -> + (let _lhsOcore :: Core_UserStatement + _lhsOtypevariables :: Names + _lhsOself :: UserStatement + _lhsOmetaVariableConstraintNames :: Names + _lhsOuserConstraints :: (TypeConstraints ConstraintInfo) + _lhsOuserPredicates :: Predicates + _lhsOcore = + CorePhase phase_ + _lhsOtypevariables = + [] + _self = + UserStatement_Phase phase_ + _lhsOself = + _self + _lhsOmetaVariableConstraintNames = + _lhsImetaVariableConstraintNames + _lhsOuserConstraints = + _lhsIuserConstraints + _lhsOuserPredicates = + _lhsIuserPredicates + in ( _lhsOcore,_lhsOmetaVariableConstraintNames,_lhsOself,_lhsOtypevariables,_lhsOuserConstraints,_lhsOuserPredicates))) +-- UserStatements ---------------------------------------------- +-- cata +sem_UserStatements :: UserStatements -> + T_UserStatements +sem_UserStatements list = + (Prelude.foldr sem_UserStatements_Cons sem_UserStatements_Nil (Prelude.map sem_UserStatement list)) +-- semantic domain +type T_UserStatements = ([((String, Maybe String), MessageBlock)]) -> + Names -> + ([(Name,Tp)]) -> + ConstraintInfo -> + (TypeConstraints ConstraintInfo) -> + Predicates -> + ( Core_UserStatements,Names,UserStatements,Names,(TypeConstraints ConstraintInfo),Predicates) +data Inh_UserStatements = Inh_UserStatements {attributeTable_Inh_UserStatements :: ([((String, Maybe String), MessageBlock)]),metaVariableConstraintNames_Inh_UserStatements :: Names,nameMap_Inh_UserStatements :: ([(Name,Tp)]),standardConstraintInfo_Inh_UserStatements :: ConstraintInfo,userConstraints_Inh_UserStatements :: (TypeConstraints ConstraintInfo),userPredicates_Inh_UserStatements :: Predicates} +data Syn_UserStatements = Syn_UserStatements {core_Syn_UserStatements :: Core_UserStatements,metaVariableConstraintNames_Syn_UserStatements :: Names,self_Syn_UserStatements :: UserStatements,typevariables_Syn_UserStatements :: Names,userConstraints_Syn_UserStatements :: (TypeConstraints ConstraintInfo),userPredicates_Syn_UserStatements :: Predicates} +wrap_UserStatements :: T_UserStatements -> + Inh_UserStatements -> + Syn_UserStatements +wrap_UserStatements sem (Inh_UserStatements _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates) = + (let ( _lhsOcore,_lhsOmetaVariableConstraintNames,_lhsOself,_lhsOtypevariables,_lhsOuserConstraints,_lhsOuserPredicates) = sem _lhsIattributeTable _lhsImetaVariableConstraintNames _lhsInameMap _lhsIstandardConstraintInfo _lhsIuserConstraints _lhsIuserPredicates + in (Syn_UserStatements _lhsOcore _lhsOmetaVariableConstraintNames _lhsOself _lhsOtypevariables _lhsOuserConstraints _lhsOuserPredicates)) +sem_UserStatements_Cons :: T_UserStatement -> + T_UserStatements -> + T_UserStatements +sem_UserStatements_Cons hd_ tl_ = + (\ _lhsIattributeTable + _lhsImetaVariableConstraintNames + _lhsInameMap + _lhsIstandardConstraintInfo + _lhsIuserConstraints + _lhsIuserPredicates -> + (let _lhsOcore :: Core_UserStatements + _lhsOtypevariables :: Names + _lhsOself :: UserStatements + _lhsOmetaVariableConstraintNames :: Names + _lhsOuserConstraints :: (TypeConstraints ConstraintInfo) + _lhsOuserPredicates :: Predicates + _hdOattributeTable :: ([((String, Maybe String), MessageBlock)]) + _hdOmetaVariableConstraintNames :: Names + _hdOnameMap :: ([(Name,Tp)]) + _hdOstandardConstraintInfo :: ConstraintInfo + _hdOuserConstraints :: (TypeConstraints ConstraintInfo) + _hdOuserPredicates :: Predicates + _tlOattributeTable :: ([((String, Maybe String), MessageBlock)]) + _tlOmetaVariableConstraintNames :: Names + _tlOnameMap :: ([(Name,Tp)]) + _tlOstandardConstraintInfo :: ConstraintInfo + _tlOuserConstraints :: (TypeConstraints ConstraintInfo) + _tlOuserPredicates :: Predicates + _hdIcore :: Core_UserStatement + _hdImetaVariableConstraintNames :: Names + _hdIself :: UserStatement + _hdItypevariables :: Names + _hdIuserConstraints :: (TypeConstraints ConstraintInfo) + _hdIuserPredicates :: Predicates + _tlIcore :: Core_UserStatements + _tlImetaVariableConstraintNames :: Names + _tlIself :: UserStatements + _tlItypevariables :: Names + _tlIuserConstraints :: (TypeConstraints ConstraintInfo) + _tlIuserPredicates :: Predicates + _lhsOcore = + _hdIcore : _tlIcore + _lhsOtypevariables = + _hdItypevariables ++ _tlItypevariables + _self = + (:) _hdIself _tlIself + _lhsOself = + _self + _lhsOmetaVariableConstraintNames = + _tlImetaVariableConstraintNames + _lhsOuserConstraints = + _tlIuserConstraints + _lhsOuserPredicates = + _tlIuserPredicates + _hdOattributeTable = + _lhsIattributeTable + _hdOmetaVariableConstraintNames = + _lhsImetaVariableConstraintNames + _hdOnameMap = + _lhsInameMap + _hdOstandardConstraintInfo = + _lhsIstandardConstraintInfo + _hdOuserConstraints = + _lhsIuserConstraints + _hdOuserPredicates = + _lhsIuserPredicates + _tlOattributeTable = + _lhsIattributeTable + _tlOmetaVariableConstraintNames = + _hdImetaVariableConstraintNames + _tlOnameMap = + _lhsInameMap + _tlOstandardConstraintInfo = + _lhsIstandardConstraintInfo + _tlOuserConstraints = + _hdIuserConstraints + _tlOuserPredicates = + _hdIuserPredicates + ( _hdIcore,_hdImetaVariableConstraintNames,_hdIself,_hdItypevariables,_hdIuserConstraints,_hdIuserPredicates) = + hd_ _hdOattributeTable _hdOmetaVariableConstraintNames _hdOnameMap _hdOstandardConstraintInfo _hdOuserConstraints _hdOuserPredicates + ( _tlIcore,_tlImetaVariableConstraintNames,_tlIself,_tlItypevariables,_tlIuserConstraints,_tlIuserPredicates) = + tl_ _tlOattributeTable _tlOmetaVariableConstraintNames _tlOnameMap _tlOstandardConstraintInfo _tlOuserConstraints _tlOuserPredicates + in ( _lhsOcore,_lhsOmetaVariableConstraintNames,_lhsOself,_lhsOtypevariables,_lhsOuserConstraints,_lhsOuserPredicates))) +sem_UserStatements_Nil :: T_UserStatements +sem_UserStatements_Nil = + (\ _lhsIattributeTable + _lhsImetaVariableConstraintNames + _lhsInameMap + _lhsIstandardConstraintInfo + _lhsIuserConstraints + _lhsIuserPredicates -> + (let _lhsOcore :: Core_UserStatements + _lhsOtypevariables :: Names + _lhsOself :: UserStatements + _lhsOmetaVariableConstraintNames :: Names + _lhsOuserConstraints :: (TypeConstraints ConstraintInfo) + _lhsOuserPredicates :: Predicates + _lhsOcore = + [] + _lhsOtypevariables = + [] + _self = + [] + _lhsOself = + _self + _lhsOmetaVariableConstraintNames = + _lhsImetaVariableConstraintNames + _lhsOuserConstraints = + _lhsIuserConstraints + _lhsOuserPredicates = + _lhsIuserPredicates + in ( _lhsOcore,_lhsOmetaVariableConstraintNames,_lhsOself,_lhsOtypevariables,_lhsOuserConstraints,_lhsOuserPredicates))) diff --git a/src/Helium/StaticAnalysis/Heuristics/HeuristicsInfo.hs b/src/Helium/StaticAnalysis/Heuristics/HeuristicsInfo.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Heuristics/HeuristicsInfo.hs @@ -0,0 +1,253 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| Module : HeuristicsInfo + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Contains instance declarations. he type graph heuristics can be deployed + using the additional information that is stored by the Helium compiler for + each type constraint +-} + +module Helium.StaticAnalysis.Heuristics.HeuristicsInfo where + +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Helium.StaticAnalysis.Heuristics.RepairHeuristics +import Helium.StaticAnalysis.Heuristics.TieBreakerHeuristics +import Helium.StaticAnalysis.Heuristics.OnlyResultHeuristics +import Helium.StaticAnalysis.Heuristics.UnifierHeuristics +import Helium.StaticAnalysis.Miscellaneous.DoublyLinkedTree +import Helium.Utils.OneLiner +import Helium.StaticAnalysis.Miscellaneous.UHA_Source +import Helium.Syntax.UHA_Syntax +import Helium.StaticAnalysis.Messages.Messages +import Helium.StaticAnalysis.Messages.HeliumMessages () +import Helium.StaticAnalysis.Messages.TypeErrors +import Helium.Utils.Utils (internalError) +import Top.Types +import Top.Implementation.TypeGraph.Heuristic +import Data.Maybe +import Data.Char +import qualified Data.Map as M + +instance HasTrustFactor ConstraintInfo where + trustFactor cinfo = + let ntFactor = case (self . attribute . localInfo) cinfo of + UHA_Pat _ -> 3.0 + UHA_Decl _ -> 3.0 + UHA_FB _ -> 3.0 + _ -> 1.0 + in product (ntFactor : [ factor | HasTrustFactor factor <- properties cinfo ]) + +instance HasDirection ConstraintInfo where + isTopDown cinfo = or [ True | FolkloreConstraint <- properties cinfo ] + +instance MaybeImported ConstraintInfo where + maybeImportedName cinfo = + case [ name | IsImported name <- properties cinfo ] of + [] -> Nothing + n:_ -> Just (show n) + +instance HasTwoTypes ConstraintInfo where + getTwoTypes = typepair + +instance MaybeLiteral ConstraintInfo where + maybeLiteral cinfo = + let literalType x = + case x of + Literal_Int _ _ -> "Int" + Literal_Char _ _ -> "Char" + Literal_String _ _ -> "String" + Literal_Float _ _ -> "Float" + in case (self . attribute . localInfo) cinfo of + UHA_Expr (Expression_Literal _ literal ) -> Just (literalType literal) + UHA_Pat (Pattern_Literal _ literal ) -> Just (literalType literal) + _ -> Nothing + +instance IsPattern ConstraintInfo where + isPattern cinfo = + case (self . attribute . localInfo) cinfo of + UHA_Pat _ -> True + _ -> False + +instance MaybeApplication ConstraintInfo where + maybeNumberOfArguments = + fmap (length . snd) . maybeApplicationEdge + + maybeApplicationEdge cinfo = + let list = [ (b, zip (map self infoTrees) (map fromJust tps)) + | ApplicationEdge b infoTrees <- properties cinfo + , let tps = map assignedType infoTrees + , all isJust tps + ] + in case list of + [] -> Nothing + tuple:_ -> Just tuple + +instance MaybeUnaryMinus ConstraintInfo where + maybeUnaryMinus cinfo = + case (self . attribute . localInfo) cinfo of + UHA_Expr (Expression_InfixApplication _ + (MaybeExpression_Just _) + (Expression_Variable _ name) + (MaybeExpression_Just (Expression_Literal _ literal))) + | show name == "-" -> + case literal of + Literal_Int _ s -> Just (Left (read s)) + _ -> Nothing + | show name == "-." -> + case literal of + Literal_Float _ s -> Just (Right (read s)) + _ -> Nothing + _ -> Nothing + +instance MaybeNegation ConstraintInfo where + maybeNegation cinfo = + case (self . attribute . localInfo) cinfo of + UHA_Expr (Expression_Negate _ _) -> Just True + UHA_Expr (Expression_NegateFloat _ _) -> Just False + _ -> Nothing + +instance IsExprVariable ConstraintInfo where -- misleading name? + isExprVariable cinfo = + case (self . attribute . localInfo) cinfo of + UHA_Expr (Expression_Variable _ _) -> + not $ null [ () | InstantiatedTypeScheme _ <- properties cinfo ] + _ -> False + + isEmptyInfixApplication cinfo = + case (self . attribute . localInfo) cinfo of + UHA_Expr (Expression_InfixApplication _ MaybeExpression_Nothing _ MaybeExpression_Nothing) -> True + _ -> False + +instance IsFunctionBinding ConstraintInfo where + isExplicitlyTyped cinfo = + or [ True | ExplicitTypedBinding <- properties cinfo ] + + maybeFunctionBinding cinfo = + case [ t | FuntionBindingEdge t <- properties cinfo ] of + [] -> Nothing + t:_ -> Just t + +instance IsTupleEdge ConstraintInfo where + isTupleEdge cinfo = + case (self . attribute . localInfo) cinfo of + UHA_Expr (Expression_Tuple _ _) -> True + UHA_Pat (Pattern_Tuple _ _) -> True + _ -> False + +instance WithHints ConstraintInfo where + addHint descr str = addProperty (WithHint (descr, MessageString str)) + typeErrorForTerm = specialApplicationTypeError + +instance IsUnifier ConstraintInfo where + typeErrorForUnifier = specialUnifierTypeError + isUnifier cinfo = + case [ (u, t) | Unifier u t <- properties cinfo ] of + [] -> Nothing + t:_ -> Just t + +makeUnifier :: Name -> String -> M.Map Name Tp -> InfoTree -> Property +makeUnifier name location' environment infoTree = + let unifier = maybe (-1) (head . ftv) (M.lookup name environment) + tuple = ("variable of "++location', attribute (findVariableInPat name infoTree), "variable") + in Unifier unifier tuple + +specialApplicationTypeError :: (Bool,Bool) -> Int -> OneLineTree -> (Tp,Tp) -> Range -> ConstraintInfo -> ConstraintInfo +specialApplicationTypeError (isInfixApplication,isPatternApplication) argumentNumber termOneLiner (t1, t2) range cinfo = + let typeError = TypeError [range] [oneLiner] table [] + oneLiner = MessageOneLiner (MessageString ("Type error in " ++ location cinfo)) + table = [ description1 <:> MessageOneLineTree (oneLinerSource source1) + , description2 <:> MessageOneLineTree (oneLinerSource source2) + , "type" >:> MessageType functionType + , description3 <:> MessageOneLineTree termOneLiner + , "type" >:> MessageType (toTpScheme t1) + , "does not match" >:> MessageType (toTpScheme t2) + ] + (description1, source1, source2) = + case convertSources (sources cinfo) of + [(d1,s1), (_, s2)] -> (d1, s1, s2) + _ -> internalError "ConstraintInfo" "specialApplicationTypeError" "expected two elements in list" + description2 + | isPatternApplication = "constructor" + | not isInfixApplication = "function" + | otherwise = + case show (MessageOneLineTree (oneLinerSource source2)) of + c:_ | isLower c -> "function" + | isUpper c -> "constructor" + _ -> "operator" + functionType = toTpScheme (fst (typepair cinfo)) + description3 + | isInfixApplication = if argumentNumber == 0 then "left operand" else "right operand" + | otherwise = ordinal False (argumentNumber + 1) ++ " argument" + in setTypeError typeError (setTypePair (t1, t2) cinfo) + +specialUnifierTypeError :: (Tp, Tp) -> (ConstraintInfo, ConstraintInfo) -> ConstraintInfo +specialUnifierTypeError (t1, t2) (info1, info2) = + let typeError = TypeError [range] [oneLiner] table hints + range = rangeOfSource source + oneLiner = MessageOneLiner (MessageString ("Type error in " ++ loc1)) + table = [ description <:> maybeAddLocation source + , descr1 <:> source1 + , "type" >:> MessageType (toTpScheme t1) + , descr2 <:> source2 + , "type" >:> MessageType (toTpScheme t2) + ] + description = descriptionOfSource source + (loc1, localInfo', descr1) = snd (fromJust (isUnifier info1)) + (_ ,_ , descr2) = snd (fromJust (isUnifier info2)) + source = self localInfo' + (source1, source2) = + let f (src, msrc) = maybeAddLocation (fromMaybe src msrc) + in (f (sources info1), f (sources info2)) + hints = [] -- [("because", MessageString "these two types cannot be unified")] + in setTypeError typeError (setTypePair (t1,t2 ) info1) + +skip_UHA_FB_RHS :: InfoTree -> InfoTree +skip_UHA_FB_RHS tree = + case self (attribute tree) of + UHA_FB _ -> maybe tree skip_UHA_FB_RHS (parent tree) + UHA_RHS _ -> maybe tree skip_UHA_FB_RHS (parent tree) + _ -> tree + +findVariableInPat :: Name -> InfoTree -> InfoTree +findVariableInPat name tree = + case children tree of + [] -> tree + cs -> let p x = case self (attribute x) of + UHA_Pat pat -> hasVariable name pat + _ -> False + in case filter p cs of + [] -> tree + child:_ -> findVariableInPat name child + +hasVariable :: Name -> Pattern -> Bool +hasVariable name pattern = + case pattern of + Pattern_Variable _ n -> name == n + Pattern_As _ n pat -> name == n || hasVariable name pat + Pattern_Parenthesized _ pat -> hasVariable name pat + Pattern_InfixConstructor _ pat1 _ pat2 -> hasVariable name pat1 || hasVariable name pat2 + Pattern_Constructor _ _ pats -> any (hasVariable name) pats + Pattern_List _ pats -> any (hasVariable name) pats + Pattern_Tuple _ pats -> any (hasVariable name) pats + _ -> False + +maybeAddLocation :: UHA_Source -> MessageBlock +maybeAddLocation src + | match = + MessageCompose + [ MessageOneLineTree (oneLinerSource src) + , MessageString " at " + , MessageRange (rangeOfSource src) + ] + | otherwise = + MessageOneLineTree (oneLinerSource src) + + where match = + case src of + UHA_Expr (Expression_Variable _ _) -> True + UHA_Pat (Pattern_Variable _ _) -> True + _ -> False diff --git a/src/Helium/StaticAnalysis/Heuristics/ListOfHeuristics.hs b/src/Helium/StaticAnalysis/Heuristics/ListOfHeuristics.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Heuristics/ListOfHeuristics.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE FlexibleContexts #-} +{-| Module : ListOfHeuristics + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + A list of all type graph heuristics that is used. +-} + +module Helium.StaticAnalysis.Heuristics.ListOfHeuristics (listOfHeuristics) where + +import Helium.Main.Args (Option(..)) +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Helium.StaticAnalysis.Heuristics.HeuristicsInfo () -- instances +import Top.Implementation.TypeGraph.Heuristic +import Top.Implementation.TypeGraph.DefaultHeuristics +-- import RepairSystem (repairSystem) +import Top.Implementation.TypeGraph.ClassMonadic +import Helium.StaticAnalysis.Heuristics.RepairHeuristics +import Helium.StaticAnalysis.Heuristics.UnifierHeuristics +import Helium.StaticAnalysis.Heuristics.OnlyResultHeuristics +import Helium.StaticAnalysis.Heuristics.TieBreakerHeuristics + +-- temporary +import Top.Implementation.TypeGraph.Path +import Data.Maybe +import Top.Implementation.TypeGraph.Basics + +listOfHeuristics :: [Option] -> Siblings -> Path (EdgeId, ConstraintInfo) -> [Heuristic ConstraintInfo] +listOfHeuristics options siblings path = + let is = [ makeEdgeNr i | SelectConstraintNumber i <- options ] + in [ selectConstraintNumbers is | not (null is) ] + ++ + [ avoidForbiddenConstraints -- remove constraints that should NEVER be reported + , highParticipation 0.95 path + , phaseFilter -- phasing from the type inference directives + ] ++ + -- Repair system is disabled + -- [ repairSystem | NoRepairHeuristics `notElem` options + -- ] ++ + [ Heuristic (Voting ( + [ siblingFunctions siblings + , siblingLiterals + , applicationHeuristic + , variableFunction -- Similar to applicationHeuristic, works in absence of application node + , tupleHeuristic -- Similar to applicationHeuristic, but for tuples + , fbHasTooManyArguments + , constraintFromUser path -- From .type files + , unaryMinus (Overloading `elem` options) + ] ++ + [ similarNegation | Overloading `notElem` options ] ++ -- Avoid mix-up of -. and - if non-overloaded + [ unifierVertex | UnifierHeuristics `elem` options ])) + | NoRepairHeuristics `notElem` options -- All selectors are turned off when NoRepairHeuristics is on. + ] ++ + [ inPredicatePath | Overloading `elem` options ] ++ + [ avoidApplicationConstraints + , avoidNegationConstraints + -- , typeVariableInvolved -- I am not convinced yet. Bastiaan + , avoidTrustedConstraints + , avoidFolkloreConstraints + , firstComeFirstBlamed + ] + +-- Never report a constraint which is highly trusted +-- (even if this means that you have to report multiple errors) +-- This should be the first heuristic that is applied +avoidForbiddenConstraints :: Heuristic ConstraintInfo +avoidForbiddenConstraints = Heuristic ( + let f (_, info) = return (not (isHighlyTrusted info)) + in edgeFilter "Avoid forbidden constraints" f) + +-- two more heuristics for the Type Inference Directives +-- (move to another module?) +phaseFilter :: Heuristic ConstraintInfo +phaseFilter = Heuristic ( + let f (_, info) = return (phaseOfConstraint info) + in maximalEdgeFilter "Highest phase number" f) + +constraintFromUser :: HasTypeGraph m ConstraintInfo => Path (EdgeId, ConstraintInfo) -> Selector m ConstraintInfo +constraintFromUser path = + SelectorList ("Constraints from .type file", helper path) + + where + helper path' edges = + let + bestEdge = rec_ path' + edgeNrs = [ i | (EdgeId _ _ i, _) <- edges ] + + rec_ path'' = + case path'' of + x :|: y -> f min (rec_ x) (rec_ y) + x :+: y -> f max (rec_ x) (rec_ y) + Step (EdgeId _ _ cNR, info) | isJust (maybeUserConstraint info) && cNR `elem` edgeNrs + -> Just cNR + _ -> Nothing + + f :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a + f g ma mb = + case (ma, mb) of + (Just a, Just b) -> Just (g a b) + (Nothing, _ ) -> mb + _ -> ma + in + case [ tuple | tuple@(EdgeId _ _ cNR, _) <- edges, Just cNR == bestEdge ] of + [] -> return Nothing + (edgeID, info):_ -> + let (groupID, number) = fromMaybe (0, 0) (maybeUserConstraint info) + otherEdges = let p info' = + case maybeUserConstraint info' of + Just (a, b) -> a == groupID && b > number + Nothing -> False + in [ e | (e, i) <- edges, p i ] -- perhaps over all edges! + in return . Just $ + (8, "constraints from .type file", edgeID:otherEdges, info) diff --git a/src/Helium/StaticAnalysis/Heuristics/OnlyResultHeuristics.hs b/src/Helium/StaticAnalysis/Heuristics/OnlyResultHeuristics.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Heuristics/OnlyResultHeuristics.hs @@ -0,0 +1,74 @@ +{-| Module : OnlyResultHeuristics + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Two (filter) heuristics that prevent an application or a negation to be + reported as incorrect if only the result type is reponsible for non-unifiability. +-} + +module Helium.StaticAnalysis.Heuristics.OnlyResultHeuristics where + +import Top.Implementation.TypeGraph.Heuristic +import Top.Interface.TypeInference +import Top.Types +import Helium.StaticAnalysis.Miscellaneous.UHA_Source + +----------------------------------------------------------------------------- + +class MaybeApplication a where + maybeNumberOfArguments :: a -> Maybe Int + maybeApplicationEdge :: a -> Maybe (Bool, [(UHA_Source, Tp)]) + +class IsPattern a where + isPattern :: a -> Bool + +avoidApplicationConstraints :: (HasTwoTypes info, MaybeApplication info) => Heuristic info +avoidApplicationConstraints = + Heuristic (edgeFilter "Avoid application constraints" f) where + + f pair@(_, info) = + case maybeNumberOfArguments info of + Nothing -> return True + Just nrArgs -> + doWithoutEdge pair $ + + do synonyms <- getTypeSynonyms + (maybeFunctionType, maybeExpectedType) <- getSubstitutedTypes info + case (maybeFunctionType,maybeExpectedType) of + (Just functionType,Just expectedType) -> return (not onlyResult) + + where + onlyResult = length xs == nrArgs && + length ys == nrArgs && + unifiable synonyms (tupleType xs) (tupleType ys) + xs = fst (functionSpineOfLength nrArgs functionType) + ys = fst (functionSpineOfLength nrArgs expectedType) + _ -> return True + + +----------------------------------------------------------------------------- + +class MaybeNegation a where + maybeNegation :: a -> Maybe Bool + +avoidNegationConstraints :: (HasTwoTypes info, MaybeNegation info) => Heuristic info +avoidNegationConstraints = + Heuristic (edgeFilter "Avoid negation constraints" f) where + + f pair@(_, info) = + case maybeNegation info of + Nothing -> return True + Just isIntNegation -> doWithoutEdge pair $ + do synonyms <- getTypeSynonyms + (_, mtp) <- getSubstitutedTypes info + case mtp of + Just tp -> + let newtvar = TVar (nextFTV tp) + testtp = (if isIntNegation then intType else floatType) .->. newtvar + in return (not (unifiable synonyms tp testtp)) + _ -> return True + +----------------------------------------------------------------------------- diff --git a/src/Helium/StaticAnalysis/Heuristics/RepairHeuristics.hs b/src/Helium/StaticAnalysis/Heuristics/RepairHeuristics.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Heuristics/RepairHeuristics.hs @@ -0,0 +1,592 @@ +{-| Module : RepairHeuristics + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Heuristics that supply additional hints with a type error how a program + can be corrected. +-} + +module Helium.StaticAnalysis.Heuristics.RepairHeuristics where + +import Top.Types +import Top.Interface.TypeInference +import Top.Interface.Qualification hiding (contextReduction) +import Helium.Syntax.UHA_Syntax (Range) +import Helium.Utils.OneLiner (OneLineTree) +import Top.Implementation.TypeGraph.Heuristic +import Top.Implementation.TypeGraph.Basics +import Top.Implementation.TypeGraph.ClassMonadic +import Data.Maybe +import Helium.StaticAnalysis.Messages.Messages (showNumber, ordinal, prettyAndList) +import Helium.StaticAnalysis.Heuristics.OnlyResultHeuristics +import Data.List +import Helium.StaticAnalysis.Miscellaneous.UHA_Source + +----------------------------------------------------------------------------- + +type Siblings = [[(String, TpScheme)]] + +class MaybeImported a where + maybeImportedName :: a -> Maybe String + +siblingFunctions :: (MaybeImported info, HasTwoTypes info, WithHints info, HasTypeGraph m info) + => Siblings -> Selector m info +siblingFunctions siblings = + Selector ("Sibling functions", f) where + + f pair@(edge, info) = + case maybeImportedName info of + Nothing -> return Nothing + Just name + | null candidates -> return Nothing + | otherwise -> + doWithoutEdge pair $ + do (_, mtp) <- getSubstitutedTypes info -- Determine types of endpoints of edge when the edge is not present. + subPreds <- allSubstPredicates -- Which predicates must also be satisfied? + case mtp of + Nothing -> return Nothing + Just contextTp -> + do fits <- mapM (schemeFits contextTp subPreds . snd) candidates + case [ s | (True, (s, _)) <- zip fits candidates ] of + [] -> return Nothing + siblings' -> -- TODO: put all siblings in the message + let siblingsTextual = orList siblings' + hint = fixHint ("use "++siblingsTextual++" instead") + in return $ Just + (10,"Sibling(s) "++siblingsTextual++" instead of "++show name, [edge], hint info) + + where + orList :: [String] -> String + orList [s] = s + orList (x:xs) = foldr (\y1 y2-> y1 ++ ", " ++ y2) ("or "++x) xs + orList [] = "this should never occur" + + candidates = + let fn list + | name `notElem` map fst list = [] + | otherwise = filter ( (name /=) . fst) list + in concatMap fn siblings + + schemeFits contextTp sps scheme = + do synonyms <- getTypeSynonyms + classEnv <- getClassEnvironment + let magicNumber = 123456789 + (ps, itp) = split (snd (instantiate magicNumber scheme)) + return (unifiableInContext classEnv synonyms (map Just ps ++ sps) contextTp itp) + +----------------------------------------------------------------------------- + +class MaybeLiteral a where + maybeLiteral :: a -> Maybe String + +siblingLiterals :: (HasTypeGraph m info, MaybeLiteral info, HasTwoTypes info, WithHints info) => Selector m info +siblingLiterals = + Selector ("Sibling literals", f) where + + f pair@(edge, info) = + case maybeLiteral info of + Nothing -> return Nothing + Just literal -> + + doWithoutEdge pair $ + + do _ <- getTypeSynonyms + (_, mtp) <- getSubstitutedTypes info + + case (literal,mtp) of + + ("Int", Just (TCon "Float")) + -> let hint = fixHint "use a float literal instead" + in return $ Just + (5, "Int literal should be a Float", [edge], hint info) + + ("Float", Just (TCon "Int" )) + -> let hint = fixHint "use an int literal instead" + in return $ Just + (5, "Float literal should be an Int", [edge], hint info) + + ("Char", Just (TApp (TCon "[]") (TCon "Char"))) + -> let hint = fixHint "use a string literal instead" + in return $ Just + (5, "Char literal should be a String", [edge], hint info) + + ("String", Just (TCon "Char")) + -> let hint = fixHint "use a char literal instead" + in return $ Just + (5, "String literal should be a Char", [edge], hint info) + + _ -> return Nothing + +----------------------------------------------------------------------------- + +similarNegation :: (HasTypeGraph m info, MaybeNegation info, HasTwoTypes info, WithHints info) => Selector m info +similarNegation = + Selector ("Similar negation", f) where + + f pair@(edge, info) = + case maybeNegation info of + Nothing -> return Nothing + Just isIntNegation -> + + doWithoutEdge pair $ + + do synonyms <- getTypeSynonyms + (_, mtp) <- getSubstitutedTypes info + + case mtp of + Just tp + | floatNegationEdge && intNegation && not floatNegation + -> let hint = fixHint "use int negation (-) instead" + in return $ Just + (6, "Int negation instead of float negation", [edge], hint info) + + | intNegationEdge && not intNegation && floatNegation + -> let hint = fixHint "use float negation (-.) instead" + in return $ Just + (6, "Float negation instead of int negation", [edge], hint info) + + where intNegation = unifiable synonyms tp (intType .->. intType) + floatNegation = unifiable synonyms tp (floatType .->. floatType) + intNegationEdge = isIntNegation + floatNegationEdge = not isIntNegation + + _ -> return Nothing + +----------------------------------------------------------------------------- + +-- Clean up this function: split into smaller heuristics, and remove duplicated code. +applicationHeuristic :: (HasTypeGraph m info, MaybeApplication info, IsPattern info, HasTwoTypes info, WithHints info) => Selector m info +applicationHeuristic = + Selector ("Application heuristics", f) where + + f pair@(edge, info) = + case maybeApplicationEdge info of + Nothing -> return Nothing + Just (isBinary,tuplesForArguments) -> + + doWithoutEdge pair $ + + do classEnv <- getClassEnvironment + synonyms <- getTypeSynonyms + (maybeFunctionType, maybeExpectedType) <- getSubstitutedTypes info + subPreds <- allSubstPredicates + case (maybeFunctionType, maybeExpectedType) of + + (Just functionType, Just expectedType) + -- can a permutation of the arguments resolve the type inconsistency + -- of course, I need at least two arguments + | length argumentPermutations == 1 && length (concat argumentPermutations) > 1 -> + let p = head argumentPermutations + in + if p==[1,0] && isBinary + then + let hint = fixHint "swap the two arguments" + in return $ Just + (3, "swap the two arguments", [edge], hint info) + else + let hint = fixHint "re-order arguments" + in return $ Just + (1, "application: permute with "++show p, [edge], hint info) + + -- is there one particular argument that is inconsistent + | length incorrectArguments == 1 -> + do let (t1, _) = getTwoTypes info + mtp <- substituteTypeSafe t1 + case mtp of + Nothing -> return Nothing + Just fullTp -> + let i = head incorrectArguments + {- bug fix 25 september 2003: don't forget to expand the type synonyms -} + expandedTp = expandType (snd synonyms) fullTp + (source,tp) = tuplesForArguments !! i + range = rangeOfSource source + oneLiner = oneLinerSource source + infoFun = typeErrorForTerm (isBinary,isPatternApplication) i oneLiner (tp,expargtp) range + expargtp = fst (functionSpine expandedTp) !! i + in return $ Just + (3, "incorrect argument of application="++show i, [edge], infoFun info) + + -- too many arguments are given + | maybe False (< numberOfArguments) maximumForFunction && not isPatternApplication -> + case typesZippedWithHoles of + -- there is only one possible set to remove arguments + [is] | not isBinary && maybe True (>= 1) maximumForFunction + -> let hint = fixHint ("remove "++prettyAndList (map (ordinal True . (+1)) is)++" argument") + in return $ Just + (4, "too many arguments are given: "++show is, [edge], hint info) + + + _ -- the expression to which arguments are given does not have a function type + | maybe False (<= 0) maximumForFunction && not isBinary && not (isPattern info) -> + let hint = becauseHint "it is not a function" + in return $ Just + (6, "not a function", [edge], hint info) + + -- function used as infix that expects < 2 arguments + | maybe False (<= 1) maximumForFunction && isBinary && not (isPattern info) -> + let hint = becauseHint "it is not a binary function" + in return $ Just + (6, "no binary function", [edge], hint info) + + -- more than one or no possible set of arguments to be removed + | otherwise -> + let hint = becauseHint "too many arguments are given" + in return $ Just + (2, "too many arguments are given", [edge], hint info) + + -- not enough arguments are given + | minimumForContext > numberOfArguments && not isPatternApplication && contextIsUnifiable -> + case typesZippedWithHoles of + + [is] | not isBinary + -> let hint = fixHint ("insert a "++prettyAndList (map (ordinal True . (+1)) is)++" argument") + in return $ Just + (4, "not enough arguments are given"++show is, [edge], hint info) + + _ -> let hint = becauseHint "not enough arguments are given" + in return $ Just + (2, "not enough arguments are given", [edge], hint info) + + where unifiableTypes :: Tp -> Tp -> Bool + unifiableTypes = + unifiableInContext classEnv synonyms subPreds + + unifiableTypeLists :: Tps -> Tps -> Bool + unifiableTypeLists xs ys = + unifiableTypes (tupleType xs) (tupleType ys) + + -- number of arguments for this function application + numberOfArguments = length tuplesForArguments + + -- (->) spines for function type and expected type for the given number of arguments + (functionArguments, functionResult) = functionSpineOfLength numberOfArguments (expandType (snd synonyms) functionType) + (expectedArguments, expectedResult) = functionSpineOfLength numberOfArguments (expandType (snd synonyms) expectedType) + + -- (->) spines for function type and expected type ignoring the given number of arguments + (allFunctionArgs, allFunctionRes) = functionSpine functionType + (allExpectedArgs, allExpectedRes) = functionSpine expectedType + + -- maximum number of arguments for the function type (result type should not be polymorphic!) + -- e.g.: (a -> b) -> [a] -> [b] yields (Just 2) + -- (a -> b -> b) -> b -> [a] -> b yields Nothing + maximumForFunction = case functionSpine (expandType (snd synonyms) functionType) of + (_, TVar _) -> Nothing + (tps, _ ) -> Just (length tps) + + -- minimum number of arguments that should be applied to the function to meet the expected context type + minimumForContext = length allFunctionArgs + numberOfArguments - length allExpectedArgs + + -- is the context unifiable? + contextIsUnifiable = unifiable synonyms expectedResult (snd (functionSpineOfLength minimumForContext functionType)) + + -- is there one argument in particular that is incorrect? + incorrectArguments = [ i + | length functionArguments == length expectedArguments + , i <- [0..numberOfArguments-1] + , not (unifiableTypes (functionArguments !! i) (expectedArguments !! i)) + , unifiableTypeLists (functionResult : deleteIndex i functionArguments) + (expectedResult : deleteIndex i expectedArguments) + ] + + -- is there a permutation of the arguments that resolves the type inconsistency? + argumentPermutations = [ p + | length functionArguments == length expectedArguments + , p <- take heuristicsMAX (permutationsForLength numberOfArguments) + , unifiableTypeLists (functionResult : functionArguments) + (expectedResult : permute p expectedArguments) + ] + + -- at which locations should an extra argument be inserted? + typesZippedWithHoles = [ is + | (is,zl) <- take heuristicsMAX (zipWithHoles allFunctionArgs allExpectedArgs) + , let (as,bs) = unzip zl + , unifiableTypeLists (allFunctionRes : as) + (allExpectedRes : bs) + ] + + isPatternApplication = isPattern info + + (Just functionType, _) + + -- the expression to which arguments are given does not have a function type + | maybe False (<= 0) maximumForFunction && not isBinary && not (isPattern info) -> + let hint = becauseHint "it is not a function" + in return $ Just + (6, "not a function", [edge], hint info) + + -- function used as infix that expects < 2 arguments + | maybe False (<= 1) maximumForFunction && isBinary && not (isPattern info) -> + let hint = becauseHint "it is not a binary function" + in return $ Just + (6, "no binary function", [edge], hint info) + + -- too many arguments are given + | maybe False (< length tuplesForArguments) maximumForFunction && not (isPattern info) -> + let hint = becauseHint "too many arguments are given" + in return $ Just + (2, "too many arguments are given", [edge], hint info) + + where -- copy/paste :-( + maximumForFunction = case functionSpine (expandType (snd synonyms) functionType) of + (_, TVar _) -> Nothing + (tps, _ ) -> Just (length tps) + _ -> return Nothing + +----------------------------------------------------------------------------- + +class IsTupleEdge a where + isTupleEdge :: a -> Bool + +tupleHeuristic :: (HasTypeGraph m info, IsTupleEdge info, HasTwoTypes info, WithHints info) => Selector m info +tupleHeuristic = + Selector ("Tuple heuristics", f) where + + f pair@(edge, info) + | not (isTupleEdge info) = return Nothing + | otherwise = + + doWithoutEdge pair $ + + do classEnv <- getClassEnvironment + synonyms <- getTypeSynonyms + (mTupleTp, mExpectedTp) <- getSubstitutedTypes info + subPreds <- allSubstPredicates + case (fmap leftSpine mTupleTp,fmap leftSpine mExpectedTp) of + + (Just (TCon s,tupleTps),Just (TCon t,expectedTps)) | isTupleConstructor s && isTupleConstructor t -> + case compare (length tupleTps) (length expectedTps) of + + EQ -> -- try if a permutation can make the tuple types equivalent + let perms = take heuristicsMAX (permutationsForLength (length tupleTps)) + notUnifiable = not (unifiableInContext classEnv synonyms subPreds (tupleType tupleTps) (tupleType expectedTps)) + test perm = + let t1 = tupleType tupleTps + t2 = tupleType (permute perm expectedTps) + in unifiableInContext classEnv synonyms subPreds t1 t2 + in case filter test perms of + p:_ | notUnifiable -> -- a permutation is possible! + let hint = fixHint "re-order elements of tuple" + in return $ Just + (4, "tuple: permute with "++show p ++ show (mTupleTp, mExpectedTp), [edge], hint info) + _ -> return Nothing + + compareVal -> case [ is + | (is,zl) <- take heuristicsMAX (zipWithHoles tupleTps expectedTps) + , let (xs, ys) = unzip zl in unifiable synonyms (tupleType xs) (tupleType ys) + ] of + [is] -> case compareVal of + LT -> let hint = fixHint ("insert a "++prettyAndList (map (ordinal True. (+1)) is)++" element to the tuple") + in return $ Just + (4, "tuple:insert "++show is, [edge], hint info) + GT -> let hint = fixHint ("remove "++prettyAndList (map (ordinal True . (+1)) is)++" element of tuple") + in return $ Just + (4, "tuple:remove "++show is, [edge], hint info) + EQ -> error "this cannot occur" + _ -> let hint = becauseHint ("a "++show (length tupleTps)++"-tuple does not match a "++show (length expectedTps)++"-tuple") + in return $ Just + (2, "different sizes of tuple", [edge], hint info) + _ -> return Nothing + +----------------------------------------------------------------------------- + +class IsFunctionBinding a where + isExplicitlyTyped :: a -> Bool + maybeFunctionBinding :: a -> Maybe Int + +fbHasTooManyArguments :: (HasTypeGraph m info, IsFunctionBinding info, HasTwoTypes info, WithHints info) => Selector m info +fbHasTooManyArguments = + Selector ("Function binding heuristics", f) where + + f (edge, info) + | not (isExplicitlyTyped info) = return Nothing + | otherwise = + + do synonyms <- getTypeSynonyms + let (t2,t1) = getTwoTypes info + maximumExplicit = arityOfTp (expandType (snd synonyms) t1) + tvar = if null (ftv t2) then (-1) else head (ftv t2) -- !!!!!!!!!!!!!!!!!!! + + edgeList <- edgesFrom (VertexId tvar) + let maybeNumberOfPatterns = + case mapMaybe (maybeFunctionBinding . snd) edgeList of + [i] -> Just i + _ -> Nothing + + case maybeNumberOfPatterns of + Just n | n > maximumExplicit -> + let msg = "the function binding has "++prettyPat n++", but its type signature "++prettyArg maximumExplicit + prettyPat i = if i == 1 then "1 pattern" else show i++" patterns" + prettyArg 0 = "does not allow patterns" + prettyArg x = "allows at most "++show x + hint = becauseHint msg + in return $ Just + (8, "function binding has too many arguments", [edge], hint info) + _ -> return Nothing + +----------------------------------------------------------------------------- + +class IsExprVariable a where + isExprVariable :: a -> Bool + isEmptyInfixApplication :: a -> Bool + +variableFunction :: (HasTypeGraph m info, IsExprVariable info, MaybeApplication info, HasTwoTypes info, WithHints info) => Selector m info +variableFunction = + Selector ("Variable function", f) where + + f pair@(edge, info) + | not (isExprVariable info) + = return Nothing + | otherwise + = doWithoutEdge pair $ + + do synonyms <- getTypeSynonyms + (mt1, mt2) <- getSubstitutedTypes info + + -- is this variable involved in an application? + let EdgeId v1 v2 _ = edge + edges1 <- edgesFrom v1 + edges2 <- edgesFrom v2 + let fn (EdgeId vertex1 vertex2 _, _) = [vertex1,vertex2] + special = concatMap fn (filter (isEmptyInfixApplication . snd) (edges1 ++ edges2)) \\ [v1,v2] + edges3 <- mapM edgesFrom special + let isApplicationEdge = isJust . maybeApplicationEdge + application = any (\(_, edgeInfo) -> isApplicationEdge edgeInfo) (edges1 ++ edges2 ++ concat edges3) + + case (mt1, mt2) of + (Just functionType, Just expectedType) | not application -> + let maxArgumentsForFunction = length (fst (functionSpine functionType)) + minArgumentsForContext = maxArgumentsForFunction - length (fst (functionSpine expectedType)) + contextIsUnifiable = unifiable synonyms + (snd $ functionSpineOfLength minArgumentsForContext functionType) + expectedType + in if minArgumentsForContext <= 0 || not contextIsUnifiable + then return Nothing + else let hint = fixHint ("insert "++showNumber minArgumentsForContext++" argument"++ + if minArgumentsForContext <= 1 then "" else "s") + in return $ Just + (4, "insert arguments to function variable", [edge], hint info) + _ -> return Nothing + +----------------------------------------------------------------------------- + +class MaybeUnaryMinus a where + maybeUnaryMinus :: a -> Maybe (Either Int Float) + +unaryMinus :: (HasTypeGraph m info, MaybeApplication info, MaybeUnaryMinus info, HasTwoTypes info, WithHints info) => Bool -> Selector m info +unaryMinus overloading = + Selector ("Unary minus", f) where + + f pair@(edge, info) = + case maybeApplicationEdge info of + Just (isInfix, tuplesForArguments) | isInfix && length tuplesForArguments == 2 -> + case maybeUnaryMinus info of + Just someLiteral -> + doWithoutEdge pair $ + do synonyms <- getTypeSynonyms + let leftBeta = snd (head tuplesForArguments) + leftType <- substituteTypeSafe leftBeta + (_, mt2) <- getSubstitutedTypes info + let contextType = fmap (snd . functionSpineOfLength 2 . expandType (snd synonyms)) mt2 + case (someLiteral, leftType, contextType) of + (Left int, Just leftTp, Just contextTp) + | unifiable synonyms leftTp (intType .->. contextTp) -> + let hint = possibleHint ("Insert parentheses to negate the int literal: (-"++show int++")") + in return $ Just + (5, "Unary minus for int", [edge], hint info) + (Right float, Just leftTp, Just contextTp) + | unifiable synonyms leftTp (floatType .->. contextTp) && not overloading -> + let hint = possibleHint ("Insert parentheses to negate the float literal: (-."++show float++")") + in return $ Just + (5, "Unary minus for float", [edge], hint info) + | unifiable synonyms leftTp (floatType .->. contextTp) && overloading -> + let hint = possibleHint ("Insert parentheses to negate the float literal: (-"++show float++")") + in return $ Just + (5, "Unary minus for float (overloading)", [edge], hint info) + _ -> return Nothing + _ -> return Nothing + _ -> return Nothing + +----------------------------------------------------------------------------- +-- REST + +heuristicsMAX :: Int +heuristicsMAX = 120 + +zipWithHoles :: [a] -> [b] -> [ ( [Int] , [(a,b)] ) ] +zipWithHoles = rec_ 0 where + + rec_ i [] bs = [ (take (length bs) [i..] , []) ] + rec_ i as [] = [ (take (length as) [i..] , []) ] + rec_ i (a:as) (b:bs) = case compare (length as) (length bs) of + LT -> [ ( is,(a,b):zl) | (is,zl) <- rec_ (i+1) as bs ] + ++ [ (i:is, zl) | (is,zl) <- rec_ (i+1) (a:as) bs ] + EQ -> [ ([],zip (a:as) (b:bs)) ] + GT -> [ ( is,(a,b):zl) | (is,zl) <- rec_ (i+1) as bs ] + ++ [ (i:is, zl) | (is,zl) <- rec_ (i+1) as (b:bs) ] + +type Permutation = [Int] + +permutationsForLength :: Int -> [Permutation] +permutationsForLength 0 = [ [] ] +permutationsForLength i = [ ys | xs <- permutationsForLength (i-1), ys <- insertSomewhere (i-1) xs ] + where + insertSomewhere j [] = [ [j] ] + insertSomewhere j (x:xs) = (j:x:xs) : map (x:) (insertSomewhere j xs) + +deleteIndex :: Int -> [a] -> [a] +deleteIndex _ [] = [] +deleteIndex 0 (_:as) = as +deleteIndex i (a:as) = a : deleteIndex (i-1) as + +permute :: Permutation -> [a] -> [a] +permute is as = map (as !!) is + +class WithHints a where + addHint :: String -> String -> a -> a + typeErrorForTerm :: (Bool,Bool) -> Int -> OneLineTree -> (Tp,Tp) -> Range -> a -> a + +fixHint, becauseHint, possibleHint :: WithHints a => String -> a -> a +fixHint = addHint "probable fix" +becauseHint = addHint "because" +possibleHint = addHint "possible fix" + +------------------------------------------------------------------ + +unifiableInContext :: ClassEnvironment -> OrderedTypeSynonyms -> [Maybe Predicate] -> Tp -> Tp -> Bool +unifiableInContext classEnv synonyms mps t1 t2 + | any isNothing mps = False + | otherwise = + case mguWithTypeSynonyms synonyms t1 t2 of + Left _ -> False + Right (_, sub) -> + let ps = catMaybes mps + (_, errs) = contextReduction synonyms classEnv (sub |-> ps) + in null errs + +allSubstPredicates :: (HasTypeGraph m info) => m [Maybe Predicate] +allSubstPredicates = + do _ <- getTypeSynonyms + allPreds <- allQualifiers + let f (Predicate s tp) = + do mtp <- substituteTypeSafe tp + return (fmap (Predicate s) mtp) + mapM f allPreds + +predicatesFit :: (HasTypeGraph m info) => Predicates -> m Bool +predicatesFit ps = + do bs <- mapM predicateFits ps + return (and bs) + +predicateFits :: (HasTypeGraph m info) => Predicate -> m Bool +predicateFits (Predicate s tp) = + do synonyms <- getTypeSynonyms + classEnv <- getClassEnvironment + mtp <- substituteTypeSafe tp + case mtp of + Nothing -> return False + Just tp' -> + let (_, errs) = contextReduction synonyms classEnv [Predicate s tp'] + in return (null errs) diff --git a/src/Helium/StaticAnalysis/Heuristics/TieBreakerHeuristics.hs b/src/Helium/StaticAnalysis/Heuristics/TieBreakerHeuristics.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Heuristics/TieBreakerHeuristics.hs @@ -0,0 +1,67 @@ +{-| Module : TieBreakerHeuristics + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + A tie-breaker heuristic will be used if all other heuristics cannot decide on + which error to report. +-} + +module Helium.StaticAnalysis.Heuristics.TieBreakerHeuristics where + +import Top.Types +import Top.Interface.TypeInference (getTypeSynonyms) +import Top.Implementation.TypeGraph.Heuristic + +----------------------------------------------------------------------------- + +class HasTrustFactor a where + trustFactor :: a -> Float + +avoidTrustedConstraints :: HasTrustFactor info => Heuristic info +avoidTrustedConstraints = + Heuristic ( + let f (_, info) = return (trustFactor info) + in minimalEdgeFilter "Trust factor of edge" f) + +----------------------------------------------------------------------------- + +class HasDirection a where + isTopDown :: a -> Bool + +-- note: because True > False, we use the minimal edge filter to keep +-- all the top down edges +avoidFolkloreConstraints :: HasDirection info => Heuristic info +avoidFolkloreConstraints = + Heuristic ( + let f (_, info) = return (isTopDown info) + in minimalEdgeFilter "Is a top down edge" f) + +----------------------------------------------------------------------------- + +-- no "unification-around-a-corner-type-error" +typeVariableInvolved :: HasTwoTypes info => Heuristic info +typeVariableInvolved = + let f pair@(_, info) = + doWithoutEdge pair $ + do typeTuple <- getSubstitutedTypes info + synonyms <- getTypeSynonyms + case typeTuple of + (Just t1, Just t2) -> + let i = nextFTV (t1, t2) + (i1, t1') = changeTypeVariables i t1 + (_ , t2') = changeTypeVariables i1 t2 + in return (not (unifiable synonyms t1' t2')) + _ -> return True + in Heuristic (edgeFilter "type variable involved" f) + +changeTypeVariables :: Int -> Tp -> (Int, Tp) +changeTypeVariables i tp = + case tp of + TVar _ -> (i+1, TVar i) + TCon s -> (i, TCon s) + TApp l r -> let (i1, l') = changeTypeVariables i l + (i2, r') = changeTypeVariables i1 r + in (i2, TApp l' r') diff --git a/src/Helium/StaticAnalysis/Heuristics/UnifierHeuristics.hs b/src/Helium/StaticAnalysis/Heuristics/UnifierHeuristics.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Heuristics/UnifierHeuristics.hs @@ -0,0 +1,79 @@ +{-| Module : UnifierHeuristics + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + A heuristic that tries to blaim two program locations that both contribute + to the type error, instead of preferring (or choosing) one location over the + other. The type error messages will be more "symmetric". +-} + +module Helium.StaticAnalysis.Heuristics.UnifierHeuristics where + +import Top.Types +import Top.Interface.TypeInference +import Top.Implementation.TypeGraph.Basics +import Top.Implementation.TypeGraph.ClassMonadic +import Top.Implementation.TypeGraph.Heuristic +import Helium.StaticAnalysis.Heuristics.RepairHeuristics +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Data.Function +import Data.List (partition, sortBy) +import Data.Maybe + +class IsUnifier a where + typeErrorForUnifier :: (Tp, Tp) -> (a, a) -> a + isUnifier :: a -> Maybe (Int, (String, LocalInfo, String)) + +unifierVertex :: (HasTypeGraph m info, IsUnifier info) => Selector m info +unifierVertex = + Selector ("Unification vertex", f) where + + f (EdgeId _ _ this, info) = + case isUnifier info of + Nothing -> return Nothing + Just (unifier, _) -> + do neighbours <- edgesFrom (VertexId unifier) + let (unifiersUnsorted, contexts) = partition p (map f' neighbours) + f' (EdgeId (VertexId v1) (VertexId v2) _, info') + | v1 == unifier = (v2, info') + | otherwise = (v1, info') + p (_, info') = + case isUnifier info' of + Nothing -> False + Just (u,_) -> u == unifier + + -- sort this list by the ordering in which the type variables were assigned + -- to prevent undeterministic type error messages. + unifiers = sortBy (compare `on` fst) unifiersUnsorted + + doWithoutEdges neighbours $ + + do synonyms <- getTypeSynonyms + + unifierMTypes <- mapM (substituteTypeSafe . TVar . fst) unifiers + contextMTypes <- mapM (substituteTypeSafe . TVar . fst) contexts + if any isNothing (unifierMTypes ++ contextMTypes) then return Nothing else + + do let unifierTypes = map fromJust unifierMTypes + contextTypes = map fromJust contextMTypes + indices = + let predicate i = unifiableList synonyms (deleteIndex i unifierTypes ++ contextTypes) + in filter predicate [0..length unifierTypes - 1] + + case indices of + -- if there are exactly two branches that cause the problem, then report + -- these two in a type error + [index1, index2] | not (unifiableList synonyms (unifierTypes ++ contextTypes)) -> + let (v1, info1) = unifiers !! index1 + (v2, info2) = unifiers !! index2 + edges = [ edge | (edge@(EdgeId (VertexId va) (VertexId vb) i), _) <- neighbours, predicate va vb, this==i ] + predicate va vb = (va == unifier && vb `elem` [v1, v2]) + || (vb == unifier && va `elem` [v1, v2]) + newInfo = typeErrorForUnifier (TVar v1, TVar v2) (info1, info2) + in return $ Just + (7, "two inconsistent branches", edges, newInfo) + + _ -> return Nothing diff --git a/src/Helium/StaticAnalysis/Inferencers/BindingGroupAnalysis.hs b/src/Helium/StaticAnalysis/Inferencers/BindingGroupAnalysis.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/BindingGroupAnalysis.hs @@ -0,0 +1,144 @@ +{-| Module : BindingGroupAnalysis + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Binding groups (mutually recursive function definitions) +-} + +-- To do: clean up this module. Also see BGA for kind inferencing + +module Helium.StaticAnalysis.Inferencers.BindingGroupAnalysis where + +import qualified Data.Graph as G +import qualified Data.Tree as G +import Helium.Syntax.UHA_Syntax +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Top.Types +import Top.Ordering.Tree +import qualified Data.Map as M + +type Assumptions = M.Map Name [(Name,Tp)] +type PatternAssumptions = M.Map Name Tp +type Monos = Tps + +noAssumptions :: M.Map Name a +noAssumptions = M.empty + +listToAssumptions :: [(Name, Tp)] -> Assumptions +listToAssumptions list = + foldr combine noAssumptions [ M.fromList [(n, [tuple])] | tuple@(n, _) <- list ] + +combine :: Assumptions -> Assumptions -> Assumptions +combine = M.unionWith (++) + +single :: Name -> Tp -> Assumptions +single n t = M.singleton n [(n,t)] + +type BindingGroups = [BindingGroup] +type BindingGroup = (PatternAssumptions, Assumptions, ConstraintSets) +type InheritedBDG = [(Names, (Monos, Int))] + +emptyBindingGroup :: BindingGroup +emptyBindingGroup = + (noAssumptions, noAssumptions, []) + +combineBindingGroup :: BindingGroup -> BindingGroup -> BindingGroup +combineBindingGroup (e1,a1,c1) (e2,a2,c2) = + (e1 `M.union` e2, a1 `combine` a2, c1++c2) + +concatBindingGroups :: BindingGroups -> BindingGroup +concatBindingGroups = foldr combineBindingGroup emptyBindingGroup + +-- |Input for binding group analysis +type InputBDG = (Bool, Int, Int, Monos, M.Map Name TpScheme, Maybe (Assumptions, ConstraintSets), Int) +type OutputBDG = (Assumptions, ConstraintSet, InheritedBDG, Int, Int, M.Map Name (Sigma Predicates)) + +performBindingGroup :: InputBDG -> BindingGroups -> OutputBDG +performBindingGroup (topLevel, currentChunk, uniqueChunk, monoTypes, typeSignatures, chunkContext, unique) groups = + variableDependencies + + where + bindingGroupAnalysis :: BindingGroups -> BindingGroups + bindingGroupAnalysis cs = + let explicits = M.keys typeSignatures + indexMap = concat (zipWith f cs [0..]) + f (env,_,_) i = [ (n,i) | n <- M.keys env, n `notElem` explicits ] + edges = concat (zipWith f' cs [0..]) + f' (_,ass,_) i = [ (i,j)| n <- M.keys ass, (n',j) <- indexMap, n==n' ] + list = topSort (length cs-1) edges + in map (concatBindingGroups . map (cs !!)) list + + chunkedBindingGroups :: [(Int, BindingGroup)] + chunkedBindingGroups = + zip [uniqueChunk..] (bindingGroupAnalysis groups) ++ + case chunkContext of + Nothing -> [] + Just (a, c) -> [(currentChunk, (M.empty, a, c))] + +{- monomorphicNames :: [Name] + monomorphicNames = + let initial = let f (e, a, _) = if any (`elem` ftv monoTypes) (ftv $ map snd $ concat $ M.elems a) + then M.keys e + else [] + in concatMap f groups + expand [] _ = [] + expand (n:ns) gps = let (xs, ys) = partition p gps + p (_,a,_) = n `elem` M.keys a + f (e,_,_) = M.keys e + in n : expand (concatMap f xs ++ ns) ys + in expand initial groups -} + + variableDependencies :: OutputBDG + variableDependencies = + let (aset, cset, mt, newUnique, fm) = foldr op initial chunkedBindingGroups + in (aset, cset, mt, uniqueChunk + length groups, newUnique, fm) + + where + initial = (noAssumptions, emptyTree, [], unique, M.empty) + + op (cnr, (e, a, c)) (aset, cset, mt, un, fm) = + let (cset1,e' ) = (typeSignatures !:::! e) monoTypes cinfoBindingGroupExplicitTypedBinding + (cset2,a' ) = (typeSignatures .:::. a) (cinfoBindingGroupExplicit monoTypes (M.keys e)) + (cset3,a'' ) = (e' .===. a') cinfoSameBindingGroup + + implicits = zip [un..] (M.assocs e') + implicitsFM = M.fromList [ (name, SigmaVar sv) | (sv, (name, _)) <- implicits ] + cset4 = genConstraints monoTypes cinfoGeneralize implicits + (cset5, aset') = (implicitsFM .<==. aset) cinfoBindingGroupImplicit + + monomorphic = not topLevel -- simplification: was + -- any (`elem` monomorphicNames) (keysFM e) || cnr == currentChunk + + constraintTree = + StrictOrder + ( (if monomorphic then id else Chunk cnr) + $ StrictOrder + ( (cset1 ++ cset2 ++ cset3) .>>. Node (reverse c) ) + (listTree cset4)) + (cset5 .>>. cset) + in + ( a'' `combine` aset' + , constraintTree + , (M.keys e, (M.elems e', if monomorphic then currentChunk else cnr)) : mt + , un + M.size e' + , implicitsFM `M.union` fm + ) + +findMono :: Name -> InheritedBDG -> Monos +findMono n = let p = elem n . fst + in fst . snd . head . filter p + +getMonos :: TypeConstraints info -> Monos +getMonos tcs = [ TVar i | tc <- tcs, i <- ftv tc ] + +findCurrentChunk :: Name -> InheritedBDG -> Int +findCurrentChunk n = let p = elem n . fst + in snd . snd . head . filter p + +-- topological sort +topSort :: G.Vertex -> [G.Edge] -> [[G.Vertex]] +topSort n = map G.flatten . G.scc . G.buildG (0, n) diff --git a/src/Helium/StaticAnalysis/Inferencers/ExpressionTypeInferencer.hs b/src/Helium/StaticAnalysis/Inferencers/ExpressionTypeInferencer.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/ExpressionTypeInferencer.hs @@ -0,0 +1,43 @@ +{-| Module : ExpressionTypeInferencer + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Infer the type of an expression, and return the type errors that are encountered. +-} + +module Helium.StaticAnalysis.Inferencers.ExpressionTypeInferencer (expressionTypeInferencer) where + +import Helium.StaticAnalysis.Inferencers.TypeInferencing (sem_Module, wrap_Module, Inh_Module (..), Syn_Module (..)) +import Helium.ModuleSystem.ImportEnvironment +import Helium.StaticAnalysis.Inferencers.BindingGroupAnalysis (Assumptions) +import Helium.StaticAnalysis.Messages.TypeErrors +import Top.Types +import qualified Data.Map as M +import Helium.Syntax.UHA_Utils (nameFromString) +import Helium.Syntax.UHA_Range (noRange) +import Helium.Utils.Utils (internalError) +import Helium.Syntax.UHA_Syntax +import Data.Maybe + +expressionTypeInferencer :: ImportEnvironment -> Expression -> (TpScheme, Assumptions, TypeErrors) +expressionTypeInferencer importEnvironment expression = + let + functionName = nameFromString "_" + + module_ = Module_Module noRange MaybeName_Nothing MaybeExports_Nothing body_ + body_ = Body_Body noRange [] [decl_] + decl_ = Declaration_PatternBinding noRange pat_ rhs_ + pat_ = Pattern_Variable noRange functionName + rhs_ = RightHandSide_Expression noRange expression MaybeDeclarations_Nothing + + res = wrap_Module (sem_Module module_) Inh_Module { + importEnvironment_Inh_Module = importEnvironment, + options_Inh_Module = [] } + + inferredType = let err = internalError "ExpressionTypeInferencer.hs" "expressionTypeInferencer" "cannot find inferred type" + in fromMaybe err (M.lookup functionName $ toplevelTypes_Syn_Module res) + + in (inferredType, assumptions_Syn_Module res, typeErrors_Syn_Module res) diff --git a/src/Helium/StaticAnalysis/Inferencers/GlobalInfo.ag b/src/Helium/StaticAnalysis/Inferencers/GlobalInfo.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/GlobalInfo.ag @@ -0,0 +1,259 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Make a doubly-linked tree from the local information that is +-- available. +-- +--------------------------------------------------------------------------------------- + +--------------------------------------------------------------------------------------- +-- Right-hand side + +SEM RightHandSide [ parentTree : InfoTree | | infoTree : InfoTree ] + | Expression + loc . parentTree = node @lhs.parentTree @localInfo (@expression.infoTree : @where.infoTrees) + lhs . infoTree = @parentTree + | Guarded + loc . parentTree = node @lhs.parentTree @localInfo (@guardedexpressions.infoTrees ++ @where.infoTrees) + lhs . infoTree = @parentTree + +--------------------------------------------------------------------------------------- +-- Expression + +SEM Expression [ parentTree : InfoTree | | infoTree : InfoTree ] + | Literal + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + | Variable + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + | Hole + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + | Constructor + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + | NormalApplication + loc . parentTree = node @lhs.parentTree @localInfo (@function.infoTree : @arguments.infoTrees) + lhs . infoTree = @parentTree + | InfixApplication + loc . parentTree = node @lhs.parentTree @localInfo + (@leftExpression.infoTrees ++ [@operator.infoTree] ++ @rightExpression.infoTrees) + lhs . infoTree = @parentTree + | If + loc . parentTree = node @lhs.parentTree @localInfo [@guardExpression.infoTree, @thenExpression.infoTree, @elseExpression.infoTree] + lhs . infoTree = @parentTree + | Lambda + loc . parentTree = node @lhs.parentTree @localInfo (@patterns.infoTrees ++ [@expression.infoTree]) + lhs . infoTree = @parentTree + | Case + loc . parentTree = node @lhs.parentTree @localInfo (@expression.infoTree : @alternatives.infoTrees) + lhs . infoTree = @parentTree + | Let + loc . thisTree = node @lhs.parentTree @localInfo [@declTree, @expression.infoTree] + . declTree = node @thisTree @declInfo @declarations.infoTrees + lhs . infoTree = @thisTree + expression . parentTree = @thisTree + declarations . parentTree = @declTree + | Do + loc . parentTree = node @lhs.parentTree @localInfo @statements.infoTrees + lhs . infoTree = @parentTree + | List + loc . parentTree = node @lhs.parentTree @localInfo (@expressions.infoTrees) + lhs . infoTree = @parentTree + | Tuple + loc . parentTree = node @lhs.parentTree @localInfo (@expressions.infoTrees) + lhs . infoTree = @parentTree + | Comprehension + loc . parentTree = node @lhs.parentTree @localInfo @qualifiers.infoTrees + lhs . infoTree = @parentTree + | Typed + loc . parentTree = node @lhs.parentTree @localInfo [@expression.infoTree] + lhs . infoTree = @parentTree + | Enum + loc . parentTree = node @lhs.parentTree @localInfo (@from.infoTree : @then.infoTrees ++ @to.infoTrees) + lhs . infoTree = @parentTree + | Negate + loc . parentTree = node @lhs.parentTree @localInfo [@expression.infoTree] + lhs . infoTree = @parentTree + | NegateFloat + loc . parentTree = node @lhs.parentTree @localInfo [@expression.infoTree] + lhs . infoTree = @parentTree + +--------------------------------------------------------------------------------------- +-- Pattern + +SEM Pattern [ parentTree : InfoTree | | infoTree : InfoTree ] + | Literal + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + | Variable + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + | Hole + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + | Constructor + loc . parentTree = node @lhs.parentTree @localInfo @patterns.infoTrees + lhs . infoTree = @parentTree + | InfixConstructor + loc . parentTree = node @lhs.parentTree @localInfo [@leftPattern.infoTree, @rightPattern.infoTree] + lhs . infoTree = @parentTree + | List + loc . parentTree = node @lhs.parentTree @localInfo @patterns.infoTrees + lhs . infoTree = @parentTree + | Tuple + loc . parentTree = node @lhs.parentTree @localInfo @patterns.infoTrees + lhs . infoTree = @parentTree + | Negate + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + | As + loc . parentTree = node @lhs.parentTree @localInfo [@pattern.infoTree] + lhs . infoTree = @parentTree + | Wildcard + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + | NegateFloat + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + +--------------------------------------------------------------------------------------- +-- Statement + +SEM Statement [ parentTree : InfoTree | | infoTree : InfoTree ] + | Expression + loc . parentTree = node @lhs.parentTree @localInfo [@expression.infoTree] + lhs . infoTree = @parentTree + | Let + loc . thisTree = node @lhs.parentTree @localInfo [@declTree] + . declTree = node @thisTree @declInfo @declarations.infoTrees + lhs . infoTree = @thisTree + declarations . parentTree = @declTree + + | Generator + loc . parentTree = node @lhs.parentTree @localInfo [@pattern.infoTree, @expression.infoTree] + lhs . infoTree = @parentTree + | Empty + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + +--------------------------------------------------------------------------------------- +-- Qualifier + +SEM Qualifier [ parentTree : InfoTree | | infoTree : InfoTree ] + | Guard + loc . parentTree = node @lhs.parentTree @localInfo [@guard.infoTree] + lhs . infoTree = @parentTree + | Let + loc . thisTree = node @lhs.parentTree @localInfo [@declTree] + . declTree = node @thisTree @declInfo @declarations.infoTrees + lhs . infoTree = @thisTree + declarations . parentTree = @declTree + | Generator + loc . parentTree = node @lhs.parentTree @localInfo [@pattern.infoTree, @expression.infoTree] + lhs . infoTree = @parentTree + | Empty + loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + +--------------------------------------------------------------------------------------- +-- Combining sub-trees without introducing a new node + +SEM Body [ | | infoTree : InfoTree ] + | Hole lhs . infoTree = root (LocalInfo {self = UHA_Decls [], assignedType = Nothing, monos = []}) [] + | Body loc . parentTree = root @declInfo @declarations.infoTrees + lhs . infoTree = @parentTree + +SEM Expressions [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Cons lhs . infoTrees = @hd.infoTree : @tl.infoTrees + | Nil lhs . infoTrees = [] + +SEM MaybeExpression [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Just lhs . infoTrees = [@expression.infoTree] + | Nothing lhs . infoTrees = [] + +SEM Patterns [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Cons lhs . infoTrees = @hd.infoTree : @tl.infoTrees + | Nil lhs . infoTrees = [] + +SEM Alternatives [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Cons lhs . infoTrees = @hd.infoTrees ++ @tl.infoTrees + | Nil lhs . infoTrees = [] + +SEM Alternative [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Hole lhs . infoTrees = [] + | Alternative lhs . infoTrees = [@pattern.infoTree, @righthandside.infoTree] + | Empty lhs . infoTrees = [] + +SEM Statements [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Cons lhs . infoTrees = @hd.infoTree : @tl.infoTrees + | Nil lhs . infoTrees = [] + +SEM Qualifiers [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Cons lhs . infoTrees = @hd.infoTree : @tl.infoTrees + | Nil lhs . infoTrees = [] + +SEM GuardedExpressions [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Cons lhs . infoTrees = @hd.infoTrees ++ @tl.infoTrees + | Nil lhs . infoTrees = [] + +SEM GuardedExpression [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | GuardedExpression lhs . infoTrees = [@guard.infoTree, @expression.infoTree] + +SEM MaybeDeclarations [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Nothing lhs . infoTrees = [] + | Just loc . theNode = node @lhs.parentTree @declInfo @declarations.infoTrees + lhs . infoTrees = [@theNode] + declarations . parentTree = @theNode + +SEM Declarations [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Cons lhs . infoTrees = @hd.infoTrees ++ @tl.infoTrees + | Nil lhs . infoTrees = [] + +SEM Declaration [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Type lhs . infoTrees = [] + | Data lhs . infoTrees = [] + | Hole lhs . infoTrees = [] + | FunctionBindings loc . parentTree = node @lhs.parentTree @localInfo @bindings.infoTrees + lhs . infoTrees = [@parentTree] + | PatternBinding loc . parentTree = node @lhs.parentTree @localInfo [@pattern.infoTree, @righthandside.infoTree] + lhs . infoTrees = [@parentTree] + | TypeSignature lhs . infoTrees = [] + | Fixity lhs . infoTrees = [] + | Empty lhs . infoTrees = [] + +SEM FunctionBindings [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Cons lhs . infoTrees = @hd.infoTree : @tl.infoTrees + | Nil lhs . infoTrees = [] + +SEM FunctionBinding [ parentTree : InfoTree | | infoTree : InfoTree ] + | Hole loc . parentTree = node @lhs.parentTree @localInfo [] + lhs . infoTree = @parentTree + | FunctionBinding loc . parentTree = node @lhs.parentTree @localInfo (@lefthandside.infoTrees ++ [@righthandside.infoTree]) + lhs . infoTree = @parentTree + +SEM LeftHandSide [ parentTree : InfoTree | | infoTrees : InfoTrees ] + | Function lhs . infoTrees = @patterns.infoTrees + | Infix lhs . infoTrees = [@leftPattern.infoTree, @rightPattern.infoTree] + | Parenthesized lhs . infoTrees = @lefthandside.infoTrees ++ @patterns.infoTrees + +--------------------------------------------------------------------------------------- +-- Prevent ag-warnings + +SEM RecordPatternBinding | RecordPatternBinding loc . parentTree = globalInfoError +SEM RecordExpressionBinding | RecordExpressionBinding loc . parentTree = globalInfoError +SEM Pattern | Successor loc . infoTree = globalInfoError + | Record loc . infoTree = globalInfoError +SEM Expression | RecordConstruction loc . infoTree = globalInfoError +SEM Declaration | Default loc . infoTrees = globalInfoError + | Newtype loc . infoTrees = globalInfoError + +{ +globalInfoError :: a +globalInfoError = internalError "GlobalInfo.ag" "n/a" "global info not available" +} diff --git a/src/Helium/StaticAnalysis/Inferencers/KindInferencing.ag b/src/Helium/StaticAnalysis/Inferencers/KindInferencing.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/KindInferencing.ag @@ -0,0 +1,259 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Kind inference. +-- +--------------------------------------------------------------------------------------- + +------------------------------------------------------------------------------- +-- Attributes for kind inferencing + +ATTR Module + [ importEnvironment : ImportEnvironment + options : {[Option]} + | + | debugIO : {IO ()} + kindEnvironment : KindEnvironment + kindErrors : KindErrors + ] + +------------------------------------------------------------------------------- +-- Includes + +INCLUDE "UHA_Syntax.ag" + +------------------------------------------------------------------------------- +-- Imports + +imports { +import Top.Types +import Top.Solver.Greedy +import Top.Solver +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints +import Helium.Syntax.UHA_Syntax +import Helium.Main.Args +import qualified Data.Map as M + +-- import StaticAnalysis.Miscellaneous.TypeConstraints +import Helium.Utils.Utils (internalError) +import Helium.ModuleSystem.ImportEnvironment hiding (setTypeSynonyms) +import Helium.StaticAnalysis.Messages.KindErrors +import Data.Char (isLower) +import Helium.StaticAnalysis.Inferencers.BindingGroupAnalysis (Assumptions, PatternAssumptions, noAssumptions, combine, single, topSort) + +} + +------------------------------------------------------------------------------- +-- Semantic functions + +SEM Module + | Module lhs . kindErrors = @substitution |-> (map fst @kindErrors) + . debugIO = putStrLn (show @logEntries) + body . kappaUnique = 0 + loc . (SolveResult kappaUniqueAtTheEnd substitution _ _ kindErrors, logEntries) = + solve (solveOptions { uniqueCounter = @body.kappaUnique }) @body.constraints greedyConstraintSolver + . kindEnvironment = let f kind = generalizeAll ([] .=>. defaultToStar (@substitution |-> kind)) + in M.map f @body.environment + + +ATTR Body [ importEnvironment:ImportEnvironment | | constraints:KindConstraints environment:PatternAssumptions ] + +SEM Body + | Hole + lhs . constraints = [] + . environment = noAssumptions + | Body + declarations . bindingGroups = [] + lhs . constraints = @newConstraints ++ @cs + loc . (environment, aset, cs) = performBindingGroup @declarations.bindingGroups + . newConstraints = fst $ (@kindEnvironment .:::. @aset) (\n -> unexpected $ "Body.Body " ++ show n) + . kindEnvironment = getKindsFromImportEnvironment @lhs.importEnvironment + +ATTR Body Declarations Declaration Expressions Expression Alternatives Alternative + Statement Statements Qualifier Qualifiers RightHandSide FunctionBinding + FunctionBindings Constructor Constructors RecordExpressionBinding RecordExpressionBindings + MaybeExpression MaybeDeclarations GuardedExpression GuardedExpressions + FieldDeclaration FieldDeclarations ContextItems ContextItem + AnnotatedType AnnotatedTypes Type Types SimpleType + [ | kappaUnique:Int | ] + +ATTR Declaration Declarations Expressions Expression Alternatives Alternative + Statement Statements Qualifier Qualifiers RightHandSide FunctionBinding + FunctionBindings MaybeExpression RecordExpressionBinding RecordExpressionBindings + MaybeDeclarations GuardedExpression GuardedExpressions + [ | bindingGroups:BindingGroups | ] + +SEM Declaration + | Type + simpletype . constraints = [] + . kappaOfRHS = @type.kappa + lhs . bindingGroups = @newGroup : @lhs.bindingGroups + loc . newConstraints = fst $ (@simpletype.environment .===. @type.assumptions) (\n -> unexpected $ "Declaration.Type " ++ show n) + . newGroup = (@simpletype.declared, @type.assumptions, @newConstraints ++ @type.constraints) + + | Data + simpletype . constraints = [] + . kappaOfRHS = star + lhs . bindingGroups = @newGroup : @lhs.bindingGroups + loc . newConstraints = fst $ (@simpletype.environment .===. @constructors.assumptions) (\n -> unexpected $ "Declaration.Data " ++ show n) + . newGroup = (@simpletype.declared, @constructors.assumptions, @newConstraints ++ @constructors.constraints) + + | TypeSignature + type . constraints = [] + lhs . bindingGroups = @newGroup : @lhs.bindingGroups + . kappaUnique = @type.kappaUnique + length @tvEnv + loc . newConstraint = (@type.kappa <==> star) (mustBeStar @range.self "type signature" @type.self) + . tvEnv = zip (getTypeVariables @type.assumptions) (map TVar [@type.kappaUnique..]) + . (cset, aset) = (M.fromList @tvEnv .===. @type.assumptions) (\n -> unexpected $ "Declaration.TypeSignature " ++ show n) + . newGroup = (M.empty, @aset, @cset ++ @type.constraints ++ [@newConstraint]) + + +SEM Expression + | Typed + type . constraints = [] + lhs . bindingGroups = @newGroup : @expression.bindingGroups + . kappaUnique = @type.kappaUnique + length @tvEnv + loc . newConstraint = (@type.kappa <==> star) (mustBeStar @range.self "type annotation" @type.self) + . tvEnv = zip (getTypeVariables @type.assumptions) (map TVar [@type.kappaUnique..]) + . (cset, aset) = (M.fromList @tvEnv .===. @type.assumptions) (\n -> unexpected $ "Expression.Typed " ++ show n) + . newGroup = (M.empty, @aset, @cset ++ @type.constraints ++ [@newConstraint]) + +ATTR SimpleType [ kappaOfRHS:Kind | constraints:KindConstraints | environment:PatternAssumptions declared:PatternAssumptions ] + +SEM SimpleType + | SimpleType + lhs . environment = M.fromList (zip @typevariables.self @kappasVars) + . declared = M.singleton @name.self @kappaCon + . constraints = @newConstraint : @lhs.constraints + . kappaUnique = 1 + length @typevariables.self + @lhs.kappaUnique + loc . kappaCon = TVar @lhs.kappaUnique + . kappasVars = take (length @typevariables.self) [ TVar i | i <- [ @lhs.kappaUnique+1 .. ]] + . newConstraint = (@kappaCon .==. foldr (.->.) @lhs.kappaOfRHS @kappasVars) (unexpected "SimpleType.SimpleType") + +ATTR AnnotatedTypes Types [ | constraints:KindConstraints | assumptions:Assumptions kappas:Kinds] +ATTR AnnotatedType Type [ | constraints:KindConstraints | assumptions:Assumptions kappa:Kind ] + +SEM Type + | Application + lhs . assumptions = @function.assumptions `combine` @arguments.assumptions + . constraints = @arguments.constraints ++ [@newConstraint] + lhs . kappaUnique = @arguments.kappaUnique + 1 + loc . kappa = TVar @arguments.kappaUnique + . newConstraint = (@function.kappa <==> foldr (.->.) @kappa @arguments.kappas) (kindApplication @range.self @self @function.self) + + + | Variable + lhs . assumptions = single @name.self @kappa + . kappaUnique = @lhs.kappaUnique + 1 + loc . kappa = TVar @lhs.kappaUnique + + | Constructor + lhs . assumptions = single @name.self @kappa + . kappaUnique = @lhs.kappaUnique + 1 + loc . kappa = TVar @lhs.kappaUnique + +SEM Types + | Cons lhs . assumptions = @hd.assumptions `combine` @tl.assumptions + . kappas = @hd.kappa : @tl.kappas + | Nil lhs . assumptions = noAssumptions + . kappas = [] + +SEM AnnotatedType + | AnnotatedType + lhs . constraints = @type.constraints ++ [@newConstraint] + loc . newConstraint = (@type.kappa <==> star) (mustBeStar @range.self "data type declaration" @type.self) + +SEM AnnotatedTypes + | Cons lhs . assumptions = @hd.assumptions `combine` @tl.assumptions + . kappas = @hd.kappa : @tl.kappas + | Nil lhs . assumptions = noAssumptions + . kappas = [] + +ATTR Constructor Constructors [ | constraints:KindConstraints | assumptions:Assumptions ] + +SEM Constructor + | Infix lhs . assumptions = @leftType.assumptions `combine` @rightType.assumptions + +SEM Constructors + | Cons lhs . assumptions = @hd.assumptions `combine` @tl.assumptions + | Nil lhs . assumptions = noAssumptions + + +SEM FieldDeclaration + | FieldDeclaration loc . constraints = internalError "KindInferencing.ag" "n/a" "Field decls are not supported" +SEM Declaration + | Instance loc . constraints = internalError "KindInferencing.ag" "n/a" "instance decls are not supported" + | Default loc . constraints = internalError "KindInferencing.ag" "n/a" "default decls is not supported" + | Class loc . (constraints,kappaOfRHS) = internalError "KindInferencing.ag" "n/a" "class decls are not supported" + | Newtype loc . (constraints,kappaOfRHS) = internalError "KindInferencing.ag" "n/a" "newtype decls are not supported" +SEM ContextItem + | ContextItem loc . constraints = internalError "KindInferencing.ag" "n/a" "ContextItems are not supported" +SEM Type + | Qualified loc . (assumptions, kappa) = internalError "KindInferencing.ag" "n/a" "Qualified types are not supported" + | Forall loc . (assumptions, kappa) = internalError "KindInferencing.ag" "n/a" "Universal types are not supported" + | Exists loc . (assumptions, kappa) = internalError "KindInferencing.ag" "n/a" "Existential types are not supported" +SEM Constructor + | Record lhs . assumptions = internalError "KindInferencing.ag" "n/a" "Record constructors are not supported" + +{ + +type KindEnvironment = M.Map Name TpScheme +type KindConstraint = TypeConstraint KindError +type KindConstraints = TypeConstraints KindError + +type BindingGroups = [BindingGroup] +type BindingGroup = (PatternAssumptions,Assumptions,KindConstraints) + +combineBindingGroup :: BindingGroup -> BindingGroup -> BindingGroup +combineBindingGroup (e1,a1,c1) (e2,a2,c2) = (e1 `M.union` e2,a1 `combine` a2,c1++c2) + +concatBindingGroups :: BindingGroups -> BindingGroup +concatBindingGroups = foldr combineBindingGroup emptyBindingGroup + +emptyBindingGroup :: BindingGroup +emptyBindingGroup = (noAssumptions, noAssumptions, []) + +performBindingGroup :: BindingGroups -> (PatternAssumptions, Assumptions, KindConstraints) +performBindingGroup = glueGroups . bindingGroupAnalysis + where + bindingGroupAnalysis :: BindingGroups -> BindingGroups + bindingGroupAnalysis cs + = let indexMap = concat (zipWith f cs [0..]) + f (env,_,_) i = [ (n,i) | n <- M.keys env ] + edges = concat (zipWith f' cs [0..]) + f' (_,ass,_) i = [ (i,j)| n <- M.keys ass, (n',j) <- indexMap, n==n' ] + list = topSort (length cs-1) edges + in map (concatBindingGroups . map (cs !!)) list + + glueGroups :: BindingGroups -> (PatternAssumptions, Assumptions, KindConstraints) + glueGroups = foldr op (noAssumptions, noAssumptions, []) + where + op (env, aset, cset) (environment, assumptions, constraints) = + let (cset1,aset') = (env .===. aset) (\n -> unexpected $ "BindingGroup.same "++show n) + (cset2,assumptions') = (!<==!) [] env assumptions (\n -> unexpected $ "BindingGroup.instance "++show n) + in ( env `M.union` environment + , aset' `combine` assumptions' + , cset1 ++ cset ++ cset2 ++ constraints + ) + +getKindsFromImportEnvironment :: ImportEnvironment -> KindEnvironment +getKindsFromImportEnvironment = M.map f . typeConstructors + where f i = generalizeAll ([] .=>. foldr (.->.) star (replicate i star)) + +getTypeVariables :: Assumptions -> Names +getTypeVariables = filter p . M.keys + where p n = case show n of + [] -> False + c:_ -> isLower c + +unexpected :: String -> KindError +unexpected message = + internalError "KindInferencing.ag" "unexpected" ("unexpected kind error: "++message) + +(<==>) :: Kind -> Kind -> ((Kind, Kind) -> KindError) -> KindConstraint +(k1 <==> k2) info = (k1 .==. k2) (info (k1, k2)) +} diff --git a/src/Helium/StaticAnalysis/Inferencers/KindInferencing.hs b/src/Helium/StaticAnalysis/Inferencers/KindInferencing.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/KindInferencing.hs @@ -0,0 +1,7851 @@ +{-# LANGUAGE Rank2Types, GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Helium.StaticAnalysis.Inferencers.KindInferencing where + +import Top.Types +import Top.Solver.Greedy +import Top.Solver +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints +import Helium.Syntax.UHA_Syntax +import Helium.Main.Args +import qualified Data.Map as M + +-- import StaticAnalysis.Miscellaneous.TypeConstraints +import Helium.Utils.Utils (internalError) +import Helium.ModuleSystem.ImportEnvironment hiding (setTypeSynonyms) +import Helium.StaticAnalysis.Messages.KindErrors +import Data.Char (isLower) +import Helium.StaticAnalysis.Inferencers.BindingGroupAnalysis (Assumptions, PatternAssumptions, noAssumptions, combine, single, topSort) + +import Control.Monad.Identity (Identity) +import qualified Control.Monad.Identity + + +type KindEnvironment = M.Map Name TpScheme +type KindConstraint = TypeConstraint KindError +type KindConstraints = TypeConstraints KindError + +type BindingGroups = [BindingGroup] +type BindingGroup = (PatternAssumptions,Assumptions,KindConstraints) + +combineBindingGroup :: BindingGroup -> BindingGroup -> BindingGroup +combineBindingGroup (e1,a1,c1) (e2,a2,c2) = (e1 `M.union` e2,a1 `combine` a2,c1++c2) + +concatBindingGroups :: BindingGroups -> BindingGroup +concatBindingGroups = foldr combineBindingGroup emptyBindingGroup + +emptyBindingGroup :: BindingGroup +emptyBindingGroup = (noAssumptions, noAssumptions, []) + +performBindingGroup :: BindingGroups -> (PatternAssumptions, Assumptions, KindConstraints) +performBindingGroup = glueGroups . bindingGroupAnalysis + where + bindingGroupAnalysis :: BindingGroups -> BindingGroups + bindingGroupAnalysis cs + = let indexMap = concat (zipWith f cs [0..]) + f (env,_,_) i = [ (n,i) | n <- M.keys env ] + edges = concat (zipWith f' cs [0..]) + f' (_,ass,_) i = [ (i,j)| n <- M.keys ass, (n',j) <- indexMap, n==n' ] + list = topSort (length cs-1) edges + in map (concatBindingGroups . map (cs !!)) list + + glueGroups :: BindingGroups -> (PatternAssumptions, Assumptions, KindConstraints) + glueGroups = foldr op (noAssumptions, noAssumptions, []) + where + op (env, aset, cset) (environment, assumptions, constraints) = + let (cset1,aset') = (env .===. aset) (\n -> unexpected $ "BindingGroup.same "++show n) + (cset2,assumptions') = (!<==!) [] env assumptions (\n -> unexpected $ "BindingGroup.instance "++show n) + in ( env `M.union` environment + , aset' `combine` assumptions' + , cset1 ++ cset ++ cset2 ++ constraints + ) + +getKindsFromImportEnvironment :: ImportEnvironment -> KindEnvironment +getKindsFromImportEnvironment = M.map f . typeConstructors + where f i = generalizeAll ([] .=>. foldr (.->.) star (replicate i star)) + +getTypeVariables :: Assumptions -> Names +getTypeVariables = filter p . M.keys + where p n = case show n of + [] -> False + c:_ -> isLower c + +unexpected :: String -> KindError +unexpected message = + internalError "KindInferencing.ag" "unexpected" ("unexpected kind error: "++message) + +(<==>) :: Kind -> Kind -> ((Kind, Kind) -> KindError) -> KindConstraint +(k1 <==> k2) info = (k1 .==. k2) (info (k1, k2)) +-- Alternative ------------------------------------------------- +-- wrapper +data Inh_Alternative = Inh_Alternative { bindingGroups_Inh_Alternative :: (BindingGroups), kappaUnique_Inh_Alternative :: (Int) } +data Syn_Alternative = Syn_Alternative { bindingGroups_Syn_Alternative :: (BindingGroups), kappaUnique_Syn_Alternative :: (Int), self_Syn_Alternative :: (Alternative) } +{-# INLINABLE wrap_Alternative #-} +wrap_Alternative :: T_Alternative -> Inh_Alternative -> (Syn_Alternative ) +wrap_Alternative (T_Alternative act) (Inh_Alternative _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternative_vIn1 _lhsIbindingGroups _lhsIkappaUnique + (T_Alternative_vOut1 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_Alternative_s2 sem arg) + return (Syn_Alternative _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternative #-} +sem_Alternative :: Alternative -> T_Alternative +sem_Alternative ( Alternative_Hole range_ id_ ) = sem_Alternative_Hole ( sem_Range range_ ) id_ +sem_Alternative ( Alternative_Feedback range_ feedback_ alternative_ ) = sem_Alternative_Feedback ( sem_Range range_ ) feedback_ ( sem_Alternative alternative_ ) +sem_Alternative ( Alternative_Alternative range_ pattern_ righthandside_ ) = sem_Alternative_Alternative ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Alternative ( Alternative_Empty range_ ) = sem_Alternative_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Alternative = T_Alternative { + attach_T_Alternative :: Identity (T_Alternative_s2 ) + } +newtype T_Alternative_s2 = C_Alternative_s2 { + inv_Alternative_s2 :: (T_Alternative_v1 ) + } +data T_Alternative_s3 = C_Alternative_s3 +type T_Alternative_v1 = (T_Alternative_vIn1 ) -> (T_Alternative_vOut1 ) +data T_Alternative_vIn1 = T_Alternative_vIn1 (BindingGroups) (Int) +data T_Alternative_vOut1 = T_Alternative_vOut1 (BindingGroups) (Int) (Alternative) +{-# NOINLINE sem_Alternative_Hole #-} +sem_Alternative_Hole :: T_Range -> (Integer) -> T_Alternative +sem_Alternative_Hole arg_range_ arg_id_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule0 _rangeIself arg_id_ + _lhsOself :: Alternative + _lhsOself = rule1 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule2 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule3 _lhsIkappaUnique + __result_ = T_Alternative_vOut1 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule0 #-} + rule0 = \ ((_rangeIself) :: Range) id_ -> + Alternative_Hole _rangeIself id_ + {-# INLINE rule1 #-} + rule1 = \ _self -> + _self + {-# INLINE rule2 #-} + rule2 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule3 #-} + rule3 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Alternative_Feedback #-} +sem_Alternative_Feedback :: T_Range -> (String) -> T_Alternative -> T_Alternative +sem_Alternative_Feedback arg_range_ arg_feedback_ arg_alternative_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _alternativeX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_alternative_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Alternative_vOut1 _alternativeIbindingGroups _alternativeIkappaUnique _alternativeIself) = inv_Alternative_s2 _alternativeX2 (T_Alternative_vIn1 _alternativeObindingGroups _alternativeOkappaUnique) + _self = rule4 _alternativeIself _rangeIself arg_feedback_ + _lhsOself :: Alternative + _lhsOself = rule5 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule6 _alternativeIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule7 _alternativeIkappaUnique + _alternativeObindingGroups = rule8 _lhsIbindingGroups + _alternativeOkappaUnique = rule9 _lhsIkappaUnique + __result_ = T_Alternative_vOut1 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule4 #-} + rule4 = \ ((_alternativeIself) :: Alternative) ((_rangeIself) :: Range) feedback_ -> + Alternative_Feedback _rangeIself feedback_ _alternativeIself + {-# INLINE rule5 #-} + rule5 = \ _self -> + _self + {-# INLINE rule6 #-} + rule6 = \ ((_alternativeIbindingGroups) :: BindingGroups) -> + _alternativeIbindingGroups + {-# INLINE rule7 #-} + rule7 = \ ((_alternativeIkappaUnique) :: Int) -> + _alternativeIkappaUnique + {-# INLINE rule8 #-} + rule8 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule9 #-} + rule9 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Alternative_Alternative #-} +sem_Alternative_Alternative :: T_Range -> T_Pattern -> T_RightHandSide -> T_Alternative +sem_Alternative_Alternative arg_range_ arg_pattern_ arg_righthandside_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_RightHandSide_vOut148 _righthandsideIbindingGroups _righthandsideIkappaUnique _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideObindingGroups _righthandsideOkappaUnique) + _self = rule10 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Alternative + _lhsOself = rule11 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule12 _righthandsideIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule13 _righthandsideIkappaUnique + _righthandsideObindingGroups = rule14 _lhsIbindingGroups + _righthandsideOkappaUnique = rule15 _lhsIkappaUnique + __result_ = T_Alternative_vOut1 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule10 #-} + rule10 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Alternative_Alternative _rangeIself _patternIself _righthandsideIself + {-# INLINE rule11 #-} + rule11 = \ _self -> + _self + {-# INLINE rule12 #-} + rule12 = \ ((_righthandsideIbindingGroups) :: BindingGroups) -> + _righthandsideIbindingGroups + {-# INLINE rule13 #-} + rule13 = \ ((_righthandsideIkappaUnique) :: Int) -> + _righthandsideIkappaUnique + {-# INLINE rule14 #-} + rule14 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule15 #-} + rule15 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Alternative_Empty #-} +sem_Alternative_Empty :: T_Range -> T_Alternative +sem_Alternative_Empty arg_range_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule16 _rangeIself + _lhsOself :: Alternative + _lhsOself = rule17 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule18 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule19 _lhsIkappaUnique + __result_ = T_Alternative_vOut1 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule16 #-} + rule16 = \ ((_rangeIself) :: Range) -> + Alternative_Empty _rangeIself + {-# INLINE rule17 #-} + rule17 = \ _self -> + _self + {-# INLINE rule18 #-} + rule18 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule19 #-} + rule19 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Alternatives ------------------------------------------------ +-- wrapper +data Inh_Alternatives = Inh_Alternatives { bindingGroups_Inh_Alternatives :: (BindingGroups), kappaUnique_Inh_Alternatives :: (Int) } +data Syn_Alternatives = Syn_Alternatives { bindingGroups_Syn_Alternatives :: (BindingGroups), kappaUnique_Syn_Alternatives :: (Int), self_Syn_Alternatives :: (Alternatives) } +{-# INLINABLE wrap_Alternatives #-} +wrap_Alternatives :: T_Alternatives -> Inh_Alternatives -> (Syn_Alternatives ) +wrap_Alternatives (T_Alternatives act) (Inh_Alternatives _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternatives_vIn4 _lhsIbindingGroups _lhsIkappaUnique + (T_Alternatives_vOut4 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_Alternatives_s5 sem arg) + return (Syn_Alternatives _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternatives #-} +sem_Alternatives :: Alternatives -> T_Alternatives +sem_Alternatives list = Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) + +-- semantic domain +newtype T_Alternatives = T_Alternatives { + attach_T_Alternatives :: Identity (T_Alternatives_s5 ) + } +newtype T_Alternatives_s5 = C_Alternatives_s5 { + inv_Alternatives_s5 :: (T_Alternatives_v4 ) + } +data T_Alternatives_s6 = C_Alternatives_s6 +type T_Alternatives_v4 = (T_Alternatives_vIn4 ) -> (T_Alternatives_vOut4 ) +data T_Alternatives_vIn4 = T_Alternatives_vIn4 (BindingGroups) (Int) +data T_Alternatives_vOut4 = T_Alternatives_vOut4 (BindingGroups) (Int) (Alternatives) +{-# NOINLINE sem_Alternatives_Cons #-} +sem_Alternatives_Cons :: T_Alternative -> T_Alternatives -> T_Alternatives +sem_Alternatives_Cons arg_hd_ arg_tl_ = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_hd_)) + _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_tl_)) + (T_Alternative_vOut1 _hdIbindingGroups _hdIkappaUnique _hdIself) = inv_Alternative_s2 _hdX2 (T_Alternative_vIn1 _hdObindingGroups _hdOkappaUnique) + (T_Alternatives_vOut4 _tlIbindingGroups _tlIkappaUnique _tlIself) = inv_Alternatives_s5 _tlX5 (T_Alternatives_vIn4 _tlObindingGroups _tlOkappaUnique) + _self = rule20 _hdIself _tlIself + _lhsOself :: Alternatives + _lhsOself = rule21 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule22 _tlIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule23 _tlIkappaUnique + _hdObindingGroups = rule24 _lhsIbindingGroups + _hdOkappaUnique = rule25 _lhsIkappaUnique + _tlObindingGroups = rule26 _hdIbindingGroups + _tlOkappaUnique = rule27 _hdIkappaUnique + __result_ = T_Alternatives_vOut4 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule20 #-} + rule20 = \ ((_hdIself) :: Alternative) ((_tlIself) :: Alternatives) -> + (:) _hdIself _tlIself + {-# INLINE rule21 #-} + rule21 = \ _self -> + _self + {-# INLINE rule22 #-} + rule22 = \ ((_tlIbindingGroups) :: BindingGroups) -> + _tlIbindingGroups + {-# INLINE rule23 #-} + rule23 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule24 #-} + rule24 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule25 #-} + rule25 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule26 #-} + rule26 = \ ((_hdIbindingGroups) :: BindingGroups) -> + _hdIbindingGroups + {-# INLINE rule27 #-} + rule27 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_Alternatives_Nil #-} +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _self = rule28 () + _lhsOself :: Alternatives + _lhsOself = rule29 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule30 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule31 _lhsIkappaUnique + __result_ = T_Alternatives_vOut4 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule28 #-} + rule28 = \ (_ :: ()) -> + [] + {-# INLINE rule29 #-} + rule29 = \ _self -> + _self + {-# INLINE rule30 #-} + rule30 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule31 #-} + rule31 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- AnnotatedType ----------------------------------------------- +-- wrapper +data Inh_AnnotatedType = Inh_AnnotatedType { constraints_Inh_AnnotatedType :: (KindConstraints), kappaUnique_Inh_AnnotatedType :: (Int) } +data Syn_AnnotatedType = Syn_AnnotatedType { assumptions_Syn_AnnotatedType :: (Assumptions), constraints_Syn_AnnotatedType :: (KindConstraints), kappa_Syn_AnnotatedType :: (Kind), kappaUnique_Syn_AnnotatedType :: (Int), self_Syn_AnnotatedType :: (AnnotatedType) } +{-# INLINABLE wrap_AnnotatedType #-} +wrap_AnnotatedType :: T_AnnotatedType -> Inh_AnnotatedType -> (Syn_AnnotatedType ) +wrap_AnnotatedType (T_AnnotatedType act) (Inh_AnnotatedType _lhsIconstraints _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedType_vIn7 _lhsIconstraints _lhsIkappaUnique + (T_AnnotatedType_vOut7 _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself) <- return (inv_AnnotatedType_s8 sem arg) + return (Syn_AnnotatedType _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# INLINE sem_AnnotatedType #-} +sem_AnnotatedType :: AnnotatedType -> T_AnnotatedType +sem_AnnotatedType ( AnnotatedType_AnnotatedType range_ strict_ type_ ) = sem_AnnotatedType_AnnotatedType ( sem_Range range_ ) strict_ ( sem_Type type_ ) + +-- semantic domain +newtype T_AnnotatedType = T_AnnotatedType { + attach_T_AnnotatedType :: Identity (T_AnnotatedType_s8 ) + } +newtype T_AnnotatedType_s8 = C_AnnotatedType_s8 { + inv_AnnotatedType_s8 :: (T_AnnotatedType_v7 ) + } +data T_AnnotatedType_s9 = C_AnnotatedType_s9 +type T_AnnotatedType_v7 = (T_AnnotatedType_vIn7 ) -> (T_AnnotatedType_vOut7 ) +data T_AnnotatedType_vIn7 = T_AnnotatedType_vIn7 (KindConstraints) (Int) +data T_AnnotatedType_vOut7 = T_AnnotatedType_vOut7 (Assumptions) (KindConstraints) (Kind) (Int) (AnnotatedType) +{-# NOINLINE sem_AnnotatedType_AnnotatedType #-} +sem_AnnotatedType_AnnotatedType :: T_Range -> (Bool) -> T_Type -> T_AnnotatedType +sem_AnnotatedType_AnnotatedType arg_range_ arg_strict_ arg_type_ = T_AnnotatedType (return st8) where + {-# NOINLINE st8 #-} + st8 = let + v7 :: T_AnnotatedType_v7 + v7 = \ (T_AnnotatedType_vIn7 _lhsIconstraints _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIassumptions _typeIconstraints _typeIkappa _typeIkappaUnique _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOconstraints _typeOkappaUnique) + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule32 _newConstraint _typeIconstraints + _newConstraint = rule33 _rangeIself _typeIkappa _typeIself + _self = rule34 _rangeIself _typeIself arg_strict_ + _lhsOself :: AnnotatedType + _lhsOself = rule35 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule36 _typeIassumptions + _lhsOkappa :: Kind + _lhsOkappa = rule37 _typeIkappa + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule38 _typeIkappaUnique + _typeOconstraints = rule39 _lhsIconstraints + _typeOkappaUnique = rule40 _lhsIkappaUnique + __result_ = T_AnnotatedType_vOut7 _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself + in __result_ ) + in C_AnnotatedType_s8 v7 + {-# INLINE rule32 #-} + rule32 = \ _newConstraint ((_typeIconstraints) :: KindConstraints) -> + _typeIconstraints ++ [_newConstraint] + {-# INLINE rule33 #-} + rule33 = \ ((_rangeIself) :: Range) ((_typeIkappa) :: Kind) ((_typeIself) :: Type) -> + (_typeIkappa <==> star) (mustBeStar _rangeIself "data type declaration" _typeIself) + {-# INLINE rule34 #-} + rule34 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) strict_ -> + AnnotatedType_AnnotatedType _rangeIself strict_ _typeIself + {-# INLINE rule35 #-} + rule35 = \ _self -> + _self + {-# INLINE rule36 #-} + rule36 = \ ((_typeIassumptions) :: Assumptions) -> + _typeIassumptions + {-# INLINE rule37 #-} + rule37 = \ ((_typeIkappa) :: Kind) -> + _typeIkappa + {-# INLINE rule38 #-} + rule38 = \ ((_typeIkappaUnique) :: Int) -> + _typeIkappaUnique + {-# INLINE rule39 #-} + rule39 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule40 #-} + rule40 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- AnnotatedTypes ---------------------------------------------- +-- wrapper +data Inh_AnnotatedTypes = Inh_AnnotatedTypes { constraints_Inh_AnnotatedTypes :: (KindConstraints), kappaUnique_Inh_AnnotatedTypes :: (Int) } +data Syn_AnnotatedTypes = Syn_AnnotatedTypes { assumptions_Syn_AnnotatedTypes :: (Assumptions), constraints_Syn_AnnotatedTypes :: (KindConstraints), kappaUnique_Syn_AnnotatedTypes :: (Int), kappas_Syn_AnnotatedTypes :: (Kinds), self_Syn_AnnotatedTypes :: (AnnotatedTypes) } +{-# INLINABLE wrap_AnnotatedTypes #-} +wrap_AnnotatedTypes :: T_AnnotatedTypes -> Inh_AnnotatedTypes -> (Syn_AnnotatedTypes ) +wrap_AnnotatedTypes (T_AnnotatedTypes act) (Inh_AnnotatedTypes _lhsIconstraints _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedTypes_vIn10 _lhsIconstraints _lhsIkappaUnique + (T_AnnotatedTypes_vOut10 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOkappas _lhsOself) <- return (inv_AnnotatedTypes_s11 sem arg) + return (Syn_AnnotatedTypes _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOkappas _lhsOself) + ) + +-- cata +{-# NOINLINE sem_AnnotatedTypes #-} +sem_AnnotatedTypes :: AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes list = Prelude.foldr sem_AnnotatedTypes_Cons sem_AnnotatedTypes_Nil (Prelude.map sem_AnnotatedType list) + +-- semantic domain +newtype T_AnnotatedTypes = T_AnnotatedTypes { + attach_T_AnnotatedTypes :: Identity (T_AnnotatedTypes_s11 ) + } +newtype T_AnnotatedTypes_s11 = C_AnnotatedTypes_s11 { + inv_AnnotatedTypes_s11 :: (T_AnnotatedTypes_v10 ) + } +data T_AnnotatedTypes_s12 = C_AnnotatedTypes_s12 +type T_AnnotatedTypes_v10 = (T_AnnotatedTypes_vIn10 ) -> (T_AnnotatedTypes_vOut10 ) +data T_AnnotatedTypes_vIn10 = T_AnnotatedTypes_vIn10 (KindConstraints) (Int) +data T_AnnotatedTypes_vOut10 = T_AnnotatedTypes_vOut10 (Assumptions) (KindConstraints) (Int) (Kinds) (AnnotatedTypes) +{-# NOINLINE sem_AnnotatedTypes_Cons #-} +sem_AnnotatedTypes_Cons :: T_AnnotatedType -> T_AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes_Cons arg_hd_ arg_tl_ = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 _lhsIconstraints _lhsIkappaUnique) -> ( let + _hdX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_hd_)) + _tlX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_tl_)) + (T_AnnotatedType_vOut7 _hdIassumptions _hdIconstraints _hdIkappa _hdIkappaUnique _hdIself) = inv_AnnotatedType_s8 _hdX8 (T_AnnotatedType_vIn7 _hdOconstraints _hdOkappaUnique) + (T_AnnotatedTypes_vOut10 _tlIassumptions _tlIconstraints _tlIkappaUnique _tlIkappas _tlIself) = inv_AnnotatedTypes_s11 _tlX11 (T_AnnotatedTypes_vIn10 _tlOconstraints _tlOkappaUnique) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule41 _hdIassumptions _tlIassumptions + _lhsOkappas :: Kinds + _lhsOkappas = rule42 _hdIkappa _tlIkappas + _self = rule43 _hdIself _tlIself + _lhsOself :: AnnotatedTypes + _lhsOself = rule44 _self + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule45 _tlIconstraints + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule46 _tlIkappaUnique + _hdOconstraints = rule47 _lhsIconstraints + _hdOkappaUnique = rule48 _lhsIkappaUnique + _tlOconstraints = rule49 _hdIconstraints + _tlOkappaUnique = rule50 _hdIkappaUnique + __result_ = T_AnnotatedTypes_vOut10 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOkappas _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule41 #-} + rule41 = \ ((_hdIassumptions) :: Assumptions) ((_tlIassumptions) :: Assumptions) -> + _hdIassumptions `combine` _tlIassumptions + {-# INLINE rule42 #-} + rule42 = \ ((_hdIkappa) :: Kind) ((_tlIkappas) :: Kinds) -> + _hdIkappa : _tlIkappas + {-# INLINE rule43 #-} + rule43 = \ ((_hdIself) :: AnnotatedType) ((_tlIself) :: AnnotatedTypes) -> + (:) _hdIself _tlIself + {-# INLINE rule44 #-} + rule44 = \ _self -> + _self + {-# INLINE rule45 #-} + rule45 = \ ((_tlIconstraints) :: KindConstraints) -> + _tlIconstraints + {-# INLINE rule46 #-} + rule46 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule47 #-} + rule47 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule48 #-} + rule48 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule49 #-} + rule49 = \ ((_hdIconstraints) :: KindConstraints) -> + _hdIconstraints + {-# INLINE rule50 #-} + rule50 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_AnnotatedTypes_Nil #-} +sem_AnnotatedTypes_Nil :: T_AnnotatedTypes +sem_AnnotatedTypes_Nil = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 _lhsIconstraints _lhsIkappaUnique) -> ( let + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule51 () + _lhsOkappas :: Kinds + _lhsOkappas = rule52 () + _self = rule53 () + _lhsOself :: AnnotatedTypes + _lhsOself = rule54 _self + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule55 _lhsIconstraints + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule56 _lhsIkappaUnique + __result_ = T_AnnotatedTypes_vOut10 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOkappas _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule51 #-} + rule51 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule52 #-} + rule52 = \ (_ :: ()) -> + [] + {-# INLINE rule53 #-} + rule53 = \ (_ :: ()) -> + [] + {-# INLINE rule54 #-} + rule54 = \ _self -> + _self + {-# INLINE rule55 #-} + rule55 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule56 #-} + rule56 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Body -------------------------------------------------------- +-- wrapper +data Inh_Body = Inh_Body { importEnvironment_Inh_Body :: (ImportEnvironment), kappaUnique_Inh_Body :: (Int) } +data Syn_Body = Syn_Body { constraints_Syn_Body :: (KindConstraints), environment_Syn_Body :: (PatternAssumptions), kappaUnique_Syn_Body :: (Int), self_Syn_Body :: (Body) } +{-# INLINABLE wrap_Body #-} +wrap_Body :: T_Body -> Inh_Body -> (Syn_Body ) +wrap_Body (T_Body act) (Inh_Body _lhsIimportEnvironment _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Body_vIn13 _lhsIimportEnvironment _lhsIkappaUnique + (T_Body_vOut13 _lhsOconstraints _lhsOenvironment _lhsOkappaUnique _lhsOself) <- return (inv_Body_s14 sem arg) + return (Syn_Body _lhsOconstraints _lhsOenvironment _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Body #-} +sem_Body :: Body -> T_Body +sem_Body ( Body_Hole range_ id_ ) = sem_Body_Hole ( sem_Range range_ ) id_ +sem_Body ( Body_Body range_ importdeclarations_ declarations_ ) = sem_Body_Body ( sem_Range range_ ) ( sem_ImportDeclarations importdeclarations_ ) ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_Body = T_Body { + attach_T_Body :: Identity (T_Body_s14 ) + } +newtype T_Body_s14 = C_Body_s14 { + inv_Body_s14 :: (T_Body_v13 ) + } +data T_Body_s15 = C_Body_s15 +type T_Body_v13 = (T_Body_vIn13 ) -> (T_Body_vOut13 ) +data T_Body_vIn13 = T_Body_vIn13 (ImportEnvironment) (Int) +data T_Body_vOut13 = T_Body_vOut13 (KindConstraints) (PatternAssumptions) (Int) (Body) +{-# NOINLINE sem_Body_Hole #-} +sem_Body_Hole :: T_Range -> (Integer) -> T_Body +sem_Body_Hole arg_range_ arg_id_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 _lhsIimportEnvironment _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule57 () + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule58 () + _self = rule59 _rangeIself arg_id_ + _lhsOself :: Body + _lhsOself = rule60 _self + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule61 _lhsIkappaUnique + __result_ = T_Body_vOut13 _lhsOconstraints _lhsOenvironment _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule57 #-} + rule57 = \ (_ :: ()) -> + [] + {-# INLINE rule58 #-} + rule58 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule59 #-} + rule59 = \ ((_rangeIself) :: Range) id_ -> + Body_Hole _rangeIself id_ + {-# INLINE rule60 #-} + rule60 = \ _self -> + _self + {-# INLINE rule61 #-} + rule61 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Body_Body #-} +sem_Body_Body :: T_Range -> T_ImportDeclarations -> T_Declarations -> T_Body +sem_Body_Body arg_range_ arg_importdeclarations_ arg_declarations_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 _lhsIimportEnvironment _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importdeclarationsX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_importdeclarations_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ImportDeclarations_vOut73 _importdeclarationsIself) = inv_ImportDeclarations_s74 _importdeclarationsX74 (T_ImportDeclarations_vIn73 ) + (T_Declarations_vOut31 _declarationsIbindingGroups _declarationsIkappaUnique _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsObindingGroups _declarationsOkappaUnique) + _declarationsObindingGroups = rule62 () + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule63 _cs _newConstraints + (_environment,_aset,_cs) = rule64 _declarationsIbindingGroups + _newConstraints = rule65 _aset _kindEnvironment + _kindEnvironment = rule66 _lhsIimportEnvironment + _self = rule67 _declarationsIself _importdeclarationsIself _rangeIself + _lhsOself :: Body + _lhsOself = rule68 _self + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule69 _environment + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule70 _declarationsIkappaUnique + _declarationsOkappaUnique = rule71 _lhsIkappaUnique + __result_ = T_Body_vOut13 _lhsOconstraints _lhsOenvironment _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule62 #-} + rule62 = \ (_ :: ()) -> + [] + {-# INLINE rule63 #-} + rule63 = \ _cs _newConstraints -> + _newConstraints ++ _cs + {-# INLINE rule64 #-} + rule64 = \ ((_declarationsIbindingGroups) :: BindingGroups) -> + performBindingGroup _declarationsIbindingGroups + {-# INLINE rule65 #-} + rule65 = \ _aset _kindEnvironment -> + fst $ (_kindEnvironment .:::. _aset) (\n -> unexpected $ "Body.Body " ++ show n) + {-# INLINE rule66 #-} + rule66 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + getKindsFromImportEnvironment _lhsIimportEnvironment + {-# INLINE rule67 #-} + rule67 = \ ((_declarationsIself) :: Declarations) ((_importdeclarationsIself) :: ImportDeclarations) ((_rangeIself) :: Range) -> + Body_Body _rangeIself _importdeclarationsIself _declarationsIself + {-# INLINE rule68 #-} + rule68 = \ _self -> + _self + {-# INLINE rule69 #-} + rule69 = \ _environment -> + _environment + {-# INLINE rule70 #-} + rule70 = \ ((_declarationsIkappaUnique) :: Int) -> + _declarationsIkappaUnique + {-# INLINE rule71 #-} + rule71 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Constructor ------------------------------------------------- +-- wrapper +data Inh_Constructor = Inh_Constructor { constraints_Inh_Constructor :: (KindConstraints), kappaUnique_Inh_Constructor :: (Int) } +data Syn_Constructor = Syn_Constructor { assumptions_Syn_Constructor :: (Assumptions), constraints_Syn_Constructor :: (KindConstraints), kappaUnique_Syn_Constructor :: (Int), self_Syn_Constructor :: (Constructor) } +{-# INLINABLE wrap_Constructor #-} +wrap_Constructor :: T_Constructor -> Inh_Constructor -> (Syn_Constructor ) +wrap_Constructor (T_Constructor act) (Inh_Constructor _lhsIconstraints _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructor_vIn16 _lhsIconstraints _lhsIkappaUnique + (T_Constructor_vOut16 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOself) <- return (inv_Constructor_s17 sem arg) + return (Syn_Constructor _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructor #-} +sem_Constructor :: Constructor -> T_Constructor +sem_Constructor ( Constructor_Constructor range_ constructor_ types_ ) = sem_Constructor_Constructor ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_AnnotatedTypes types_ ) +sem_Constructor ( Constructor_Infix range_ leftType_ constructorOperator_ rightType_ ) = sem_Constructor_Infix ( sem_Range range_ ) ( sem_AnnotatedType leftType_ ) ( sem_Name constructorOperator_ ) ( sem_AnnotatedType rightType_ ) +sem_Constructor ( Constructor_Record range_ constructor_ fieldDeclarations_ ) = sem_Constructor_Record ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_FieldDeclarations fieldDeclarations_ ) + +-- semantic domain +newtype T_Constructor = T_Constructor { + attach_T_Constructor :: Identity (T_Constructor_s17 ) + } +newtype T_Constructor_s17 = C_Constructor_s17 { + inv_Constructor_s17 :: (T_Constructor_v16 ) + } +data T_Constructor_s18 = C_Constructor_s18 +type T_Constructor_v16 = (T_Constructor_vIn16 ) -> (T_Constructor_vOut16 ) +data T_Constructor_vIn16 = T_Constructor_vIn16 (KindConstraints) (Int) +data T_Constructor_vOut16 = T_Constructor_vOut16 (Assumptions) (KindConstraints) (Int) (Constructor) +{-# NOINLINE sem_Constructor_Constructor #-} +sem_Constructor_Constructor :: T_Range -> T_Name -> T_AnnotatedTypes -> T_Constructor +sem_Constructor_Constructor arg_range_ arg_constructor_ arg_types_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIconstraints _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _typesX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_AnnotatedTypes_vOut10 _typesIassumptions _typesIconstraints _typesIkappaUnique _typesIkappas _typesIself) = inv_AnnotatedTypes_s11 _typesX11 (T_AnnotatedTypes_vIn10 _typesOconstraints _typesOkappaUnique) + _self = rule72 _constructorIself _rangeIself _typesIself + _lhsOself :: Constructor + _lhsOself = rule73 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule74 _typesIassumptions + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule75 _typesIconstraints + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule76 _typesIkappaUnique + _typesOconstraints = rule77 _lhsIconstraints + _typesOkappaUnique = rule78 _lhsIkappaUnique + __result_ = T_Constructor_vOut16 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule72 #-} + rule72 = \ ((_constructorIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: AnnotatedTypes) -> + Constructor_Constructor _rangeIself _constructorIself _typesIself + {-# INLINE rule73 #-} + rule73 = \ _self -> + _self + {-# INLINE rule74 #-} + rule74 = \ ((_typesIassumptions) :: Assumptions) -> + _typesIassumptions + {-# INLINE rule75 #-} + rule75 = \ ((_typesIconstraints) :: KindConstraints) -> + _typesIconstraints + {-# INLINE rule76 #-} + rule76 = \ ((_typesIkappaUnique) :: Int) -> + _typesIkappaUnique + {-# INLINE rule77 #-} + rule77 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule78 #-} + rule78 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Constructor_Infix #-} +sem_Constructor_Infix :: T_Range -> T_AnnotatedType -> T_Name -> T_AnnotatedType -> T_Constructor +sem_Constructor_Infix arg_range_ arg_leftType_ arg_constructorOperator_ arg_rightType_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIconstraints _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_leftType_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_rightType_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_AnnotatedType_vOut7 _leftTypeIassumptions _leftTypeIconstraints _leftTypeIkappa _leftTypeIkappaUnique _leftTypeIself) = inv_AnnotatedType_s8 _leftTypeX8 (T_AnnotatedType_vIn7 _leftTypeOconstraints _leftTypeOkappaUnique) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_AnnotatedType_vOut7 _rightTypeIassumptions _rightTypeIconstraints _rightTypeIkappa _rightTypeIkappaUnique _rightTypeIself) = inv_AnnotatedType_s8 _rightTypeX8 (T_AnnotatedType_vIn7 _rightTypeOconstraints _rightTypeOkappaUnique) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule79 _leftTypeIassumptions _rightTypeIassumptions + _self = rule80 _constructorOperatorIself _leftTypeIself _rangeIself _rightTypeIself + _lhsOself :: Constructor + _lhsOself = rule81 _self + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule82 _rightTypeIconstraints + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule83 _rightTypeIkappaUnique + _leftTypeOconstraints = rule84 _lhsIconstraints + _leftTypeOkappaUnique = rule85 _lhsIkappaUnique + _rightTypeOconstraints = rule86 _leftTypeIconstraints + _rightTypeOkappaUnique = rule87 _leftTypeIkappaUnique + __result_ = T_Constructor_vOut16 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule79 #-} + rule79 = \ ((_leftTypeIassumptions) :: Assumptions) ((_rightTypeIassumptions) :: Assumptions) -> + _leftTypeIassumptions `combine` _rightTypeIassumptions + {-# INLINE rule80 #-} + rule80 = \ ((_constructorOperatorIself) :: Name) ((_leftTypeIself) :: AnnotatedType) ((_rangeIself) :: Range) ((_rightTypeIself) :: AnnotatedType) -> + Constructor_Infix _rangeIself _leftTypeIself _constructorOperatorIself _rightTypeIself + {-# INLINE rule81 #-} + rule81 = \ _self -> + _self + {-# INLINE rule82 #-} + rule82 = \ ((_rightTypeIconstraints) :: KindConstraints) -> + _rightTypeIconstraints + {-# INLINE rule83 #-} + rule83 = \ ((_rightTypeIkappaUnique) :: Int) -> + _rightTypeIkappaUnique + {-# INLINE rule84 #-} + rule84 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule85 #-} + rule85 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule86 #-} + rule86 = \ ((_leftTypeIconstraints) :: KindConstraints) -> + _leftTypeIconstraints + {-# INLINE rule87 #-} + rule87 = \ ((_leftTypeIkappaUnique) :: Int) -> + _leftTypeIkappaUnique +{-# NOINLINE sem_Constructor_Record #-} +sem_Constructor_Record :: T_Range -> T_Name -> T_FieldDeclarations -> T_Constructor +sem_Constructor_Record arg_range_ arg_constructor_ arg_fieldDeclarations_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIconstraints _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _fieldDeclarationsX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_fieldDeclarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_FieldDeclarations_vOut49 _fieldDeclarationsIkappaUnique _fieldDeclarationsIself) = inv_FieldDeclarations_s50 _fieldDeclarationsX50 (T_FieldDeclarations_vIn49 _fieldDeclarationsOkappaUnique) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule88 () + _self = rule89 _constructorIself _fieldDeclarationsIself _rangeIself + _lhsOself :: Constructor + _lhsOself = rule90 _self + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule91 _lhsIconstraints + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule92 _fieldDeclarationsIkappaUnique + _fieldDeclarationsOkappaUnique = rule93 _lhsIkappaUnique + __result_ = T_Constructor_vOut16 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule88 #-} + rule88 = \ (_ :: ()) -> + internalError "KindInferencing.ag" "n/a" "Record constructors are not supported" + {-# INLINE rule89 #-} + rule89 = \ ((_constructorIself) :: Name) ((_fieldDeclarationsIself) :: FieldDeclarations) ((_rangeIself) :: Range) -> + Constructor_Record _rangeIself _constructorIself _fieldDeclarationsIself + {-# INLINE rule90 #-} + rule90 = \ _self -> + _self + {-# INLINE rule91 #-} + rule91 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule92 #-} + rule92 = \ ((_fieldDeclarationsIkappaUnique) :: Int) -> + _fieldDeclarationsIkappaUnique + {-# INLINE rule93 #-} + rule93 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Constructors ------------------------------------------------ +-- wrapper +data Inh_Constructors = Inh_Constructors { constraints_Inh_Constructors :: (KindConstraints), kappaUnique_Inh_Constructors :: (Int) } +data Syn_Constructors = Syn_Constructors { assumptions_Syn_Constructors :: (Assumptions), constraints_Syn_Constructors :: (KindConstraints), kappaUnique_Syn_Constructors :: (Int), self_Syn_Constructors :: (Constructors) } +{-# INLINABLE wrap_Constructors #-} +wrap_Constructors :: T_Constructors -> Inh_Constructors -> (Syn_Constructors ) +wrap_Constructors (T_Constructors act) (Inh_Constructors _lhsIconstraints _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructors_vIn19 _lhsIconstraints _lhsIkappaUnique + (T_Constructors_vOut19 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOself) <- return (inv_Constructors_s20 sem arg) + return (Syn_Constructors _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructors #-} +sem_Constructors :: Constructors -> T_Constructors +sem_Constructors list = Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list) + +-- semantic domain +newtype T_Constructors = T_Constructors { + attach_T_Constructors :: Identity (T_Constructors_s20 ) + } +newtype T_Constructors_s20 = C_Constructors_s20 { + inv_Constructors_s20 :: (T_Constructors_v19 ) + } +data T_Constructors_s21 = C_Constructors_s21 +type T_Constructors_v19 = (T_Constructors_vIn19 ) -> (T_Constructors_vOut19 ) +data T_Constructors_vIn19 = T_Constructors_vIn19 (KindConstraints) (Int) +data T_Constructors_vOut19 = T_Constructors_vOut19 (Assumptions) (KindConstraints) (Int) (Constructors) +{-# NOINLINE sem_Constructors_Cons #-} +sem_Constructors_Cons :: T_Constructor -> T_Constructors -> T_Constructors +sem_Constructors_Cons arg_hd_ arg_tl_ = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 _lhsIconstraints _lhsIkappaUnique) -> ( let + _hdX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_hd_)) + _tlX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_tl_)) + (T_Constructor_vOut16 _hdIassumptions _hdIconstraints _hdIkappaUnique _hdIself) = inv_Constructor_s17 _hdX17 (T_Constructor_vIn16 _hdOconstraints _hdOkappaUnique) + (T_Constructors_vOut19 _tlIassumptions _tlIconstraints _tlIkappaUnique _tlIself) = inv_Constructors_s20 _tlX20 (T_Constructors_vIn19 _tlOconstraints _tlOkappaUnique) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule94 _hdIassumptions _tlIassumptions + _self = rule95 _hdIself _tlIself + _lhsOself :: Constructors + _lhsOself = rule96 _self + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule97 _tlIconstraints + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule98 _tlIkappaUnique + _hdOconstraints = rule99 _lhsIconstraints + _hdOkappaUnique = rule100 _lhsIkappaUnique + _tlOconstraints = rule101 _hdIconstraints + _tlOkappaUnique = rule102 _hdIkappaUnique + __result_ = T_Constructors_vOut19 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule94 #-} + rule94 = \ ((_hdIassumptions) :: Assumptions) ((_tlIassumptions) :: Assumptions) -> + _hdIassumptions `combine` _tlIassumptions + {-# INLINE rule95 #-} + rule95 = \ ((_hdIself) :: Constructor) ((_tlIself) :: Constructors) -> + (:) _hdIself _tlIself + {-# INLINE rule96 #-} + rule96 = \ _self -> + _self + {-# INLINE rule97 #-} + rule97 = \ ((_tlIconstraints) :: KindConstraints) -> + _tlIconstraints + {-# INLINE rule98 #-} + rule98 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule99 #-} + rule99 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule100 #-} + rule100 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule101 #-} + rule101 = \ ((_hdIconstraints) :: KindConstraints) -> + _hdIconstraints + {-# INLINE rule102 #-} + rule102 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_Constructors_Nil #-} +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 _lhsIconstraints _lhsIkappaUnique) -> ( let + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule103 () + _self = rule104 () + _lhsOself :: Constructors + _lhsOself = rule105 _self + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule106 _lhsIconstraints + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule107 _lhsIkappaUnique + __result_ = T_Constructors_vOut19 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule103 #-} + rule103 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule104 #-} + rule104 = \ (_ :: ()) -> + [] + {-# INLINE rule105 #-} + rule105 = \ _self -> + _self + {-# INLINE rule106 #-} + rule106 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule107 #-} + rule107 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- ContextItem ------------------------------------------------- +-- wrapper +data Inh_ContextItem = Inh_ContextItem { kappaUnique_Inh_ContextItem :: (Int) } +data Syn_ContextItem = Syn_ContextItem { kappaUnique_Syn_ContextItem :: (Int), self_Syn_ContextItem :: (ContextItem) } +{-# INLINABLE wrap_ContextItem #-} +wrap_ContextItem :: T_ContextItem -> Inh_ContextItem -> (Syn_ContextItem ) +wrap_ContextItem (T_ContextItem act) (Inh_ContextItem _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItem_vIn22 _lhsIkappaUnique + (T_ContextItem_vOut22 _lhsOkappaUnique _lhsOself) <- return (inv_ContextItem_s23 sem arg) + return (Syn_ContextItem _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItem #-} +sem_ContextItem :: ContextItem -> T_ContextItem +sem_ContextItem ( ContextItem_ContextItem range_ name_ types_ ) = sem_ContextItem_ContextItem ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Types types_ ) + +-- semantic domain +newtype T_ContextItem = T_ContextItem { + attach_T_ContextItem :: Identity (T_ContextItem_s23 ) + } +newtype T_ContextItem_s23 = C_ContextItem_s23 { + inv_ContextItem_s23 :: (T_ContextItem_v22 ) + } +data T_ContextItem_s24 = C_ContextItem_s24 +type T_ContextItem_v22 = (T_ContextItem_vIn22 ) -> (T_ContextItem_vOut22 ) +data T_ContextItem_vIn22 = T_ContextItem_vIn22 (Int) +data T_ContextItem_vOut22 = T_ContextItem_vOut22 (Int) (ContextItem) +{-# NOINLINE sem_ContextItem_ContextItem #-} +sem_ContextItem_ContextItem :: T_Range -> T_Name -> T_Types -> T_ContextItem +sem_ContextItem_ContextItem arg_range_ arg_name_ arg_types_ = T_ContextItem (return st23) where + {-# NOINLINE st23 #-} + st23 = let + v22 :: T_ContextItem_v22 + v22 = \ (T_ContextItem_vIn22 _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIassumptions _typesIconstraints _typesIkappaUnique _typesIkappas _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 _typesOconstraints _typesOkappaUnique) + _constraints = rule108 () + _self = rule109 _nameIself _rangeIself _typesIself + _lhsOself :: ContextItem + _lhsOself = rule110 _self + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule111 _typesIkappaUnique + _typesOconstraints = rule112 _constraints + _typesOkappaUnique = rule113 _lhsIkappaUnique + __result_ = T_ContextItem_vOut22 _lhsOkappaUnique _lhsOself + in __result_ ) + in C_ContextItem_s23 v22 + {-# INLINE rule108 #-} + rule108 = \ (_ :: ()) -> + internalError "KindInferencing.ag" "n/a" "ContextItems are not supported" + {-# INLINE rule109 #-} + rule109 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + ContextItem_ContextItem _rangeIself _nameIself _typesIself + {-# INLINE rule110 #-} + rule110 = \ _self -> + _self + {-# INLINE rule111 #-} + rule111 = \ ((_typesIkappaUnique) :: Int) -> + _typesIkappaUnique + {-# INLINE rule112 #-} + rule112 = \ _constraints -> + _constraints + {-# INLINE rule113 #-} + rule113 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- ContextItems ------------------------------------------------ +-- wrapper +data Inh_ContextItems = Inh_ContextItems { kappaUnique_Inh_ContextItems :: (Int) } +data Syn_ContextItems = Syn_ContextItems { kappaUnique_Syn_ContextItems :: (Int), self_Syn_ContextItems :: (ContextItems) } +{-# INLINABLE wrap_ContextItems #-} +wrap_ContextItems :: T_ContextItems -> Inh_ContextItems -> (Syn_ContextItems ) +wrap_ContextItems (T_ContextItems act) (Inh_ContextItems _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItems_vIn25 _lhsIkappaUnique + (T_ContextItems_vOut25 _lhsOkappaUnique _lhsOself) <- return (inv_ContextItems_s26 sem arg) + return (Syn_ContextItems _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItems #-} +sem_ContextItems :: ContextItems -> T_ContextItems +sem_ContextItems list = Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list) + +-- semantic domain +newtype T_ContextItems = T_ContextItems { + attach_T_ContextItems :: Identity (T_ContextItems_s26 ) + } +newtype T_ContextItems_s26 = C_ContextItems_s26 { + inv_ContextItems_s26 :: (T_ContextItems_v25 ) + } +data T_ContextItems_s27 = C_ContextItems_s27 +type T_ContextItems_v25 = (T_ContextItems_vIn25 ) -> (T_ContextItems_vOut25 ) +data T_ContextItems_vIn25 = T_ContextItems_vIn25 (Int) +data T_ContextItems_vOut25 = T_ContextItems_vOut25 (Int) (ContextItems) +{-# NOINLINE sem_ContextItems_Cons #-} +sem_ContextItems_Cons :: T_ContextItem -> T_ContextItems -> T_ContextItems +sem_ContextItems_Cons arg_hd_ arg_tl_ = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 _lhsIkappaUnique) -> ( let + _hdX23 = Control.Monad.Identity.runIdentity (attach_T_ContextItem (arg_hd_)) + _tlX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_tl_)) + (T_ContextItem_vOut22 _hdIkappaUnique _hdIself) = inv_ContextItem_s23 _hdX23 (T_ContextItem_vIn22 _hdOkappaUnique) + (T_ContextItems_vOut25 _tlIkappaUnique _tlIself) = inv_ContextItems_s26 _tlX26 (T_ContextItems_vIn25 _tlOkappaUnique) + _self = rule114 _hdIself _tlIself + _lhsOself :: ContextItems + _lhsOself = rule115 _self + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule116 _tlIkappaUnique + _hdOkappaUnique = rule117 _lhsIkappaUnique + _tlOkappaUnique = rule118 _hdIkappaUnique + __result_ = T_ContextItems_vOut25 _lhsOkappaUnique _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule114 #-} + rule114 = \ ((_hdIself) :: ContextItem) ((_tlIself) :: ContextItems) -> + (:) _hdIself _tlIself + {-# INLINE rule115 #-} + rule115 = \ _self -> + _self + {-# INLINE rule116 #-} + rule116 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule117 #-} + rule117 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule118 #-} + rule118 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_ContextItems_Nil #-} +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 _lhsIkappaUnique) -> ( let + _self = rule119 () + _lhsOself :: ContextItems + _lhsOself = rule120 _self + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule121 _lhsIkappaUnique + __result_ = T_ContextItems_vOut25 _lhsOkappaUnique _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule119 #-} + rule119 = \ (_ :: ()) -> + [] + {-# INLINE rule120 #-} + rule120 = \ _self -> + _self + {-# INLINE rule121 #-} + rule121 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Declaration ------------------------------------------------- +-- wrapper +data Inh_Declaration = Inh_Declaration { bindingGroups_Inh_Declaration :: (BindingGroups), kappaUnique_Inh_Declaration :: (Int) } +data Syn_Declaration = Syn_Declaration { bindingGroups_Syn_Declaration :: (BindingGroups), kappaUnique_Syn_Declaration :: (Int), self_Syn_Declaration :: (Declaration) } +{-# INLINABLE wrap_Declaration #-} +wrap_Declaration :: T_Declaration -> Inh_Declaration -> (Syn_Declaration ) +wrap_Declaration (T_Declaration act) (Inh_Declaration _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique + (T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_Declaration_s29 sem arg) + return (Syn_Declaration _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declaration #-} +sem_Declaration :: Declaration -> T_Declaration +sem_Declaration ( Declaration_Hole range_ id_ ) = sem_Declaration_Hole ( sem_Range range_ ) id_ +sem_Declaration ( Declaration_Type range_ simpletype_ type_ ) = sem_Declaration_Type ( sem_Range range_ ) ( sem_SimpleType simpletype_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Data range_ context_ simpletype_ constructors_ derivings_ ) = sem_Declaration_Data ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructors constructors_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Newtype range_ context_ simpletype_ constructor_ derivings_ ) = sem_Declaration_Newtype ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructor constructor_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Class range_ context_ simpletype_ where_ ) = sem_Declaration_Class ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Instance range_ context_ name_ types_ where_ ) = sem_Declaration_Instance ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Name name_ ) ( sem_Types types_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Default range_ types_ ) = sem_Declaration_Default ( sem_Range range_ ) ( sem_Types types_ ) +sem_Declaration ( Declaration_FunctionBindings range_ bindings_ ) = sem_Declaration_FunctionBindings ( sem_Range range_ ) ( sem_FunctionBindings bindings_ ) +sem_Declaration ( Declaration_PatternBinding range_ pattern_ righthandside_ ) = sem_Declaration_PatternBinding ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Declaration ( Declaration_TypeSignature range_ names_ type_ ) = sem_Declaration_TypeSignature ( sem_Range range_ ) ( sem_Names names_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Fixity range_ fixity_ priority_ operators_ ) = sem_Declaration_Fixity ( sem_Range range_ ) ( sem_Fixity fixity_ ) ( sem_MaybeInt priority_ ) ( sem_Names operators_ ) +sem_Declaration ( Declaration_Empty range_ ) = sem_Declaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Declaration = T_Declaration { + attach_T_Declaration :: Identity (T_Declaration_s29 ) + } +newtype T_Declaration_s29 = C_Declaration_s29 { + inv_Declaration_s29 :: (T_Declaration_v28 ) + } +data T_Declaration_s30 = C_Declaration_s30 +type T_Declaration_v28 = (T_Declaration_vIn28 ) -> (T_Declaration_vOut28 ) +data T_Declaration_vIn28 = T_Declaration_vIn28 (BindingGroups) (Int) +data T_Declaration_vOut28 = T_Declaration_vOut28 (BindingGroups) (Int) (Declaration) +{-# NOINLINE sem_Declaration_Hole #-} +sem_Declaration_Hole :: T_Range -> (Integer) -> T_Declaration +sem_Declaration_Hole arg_range_ arg_id_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule122 _rangeIself arg_id_ + _lhsOself :: Declaration + _lhsOself = rule123 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule124 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule125 _lhsIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule122 #-} + rule122 = \ ((_rangeIself) :: Range) id_ -> + Declaration_Hole _rangeIself id_ + {-# INLINE rule123 #-} + rule123 = \ _self -> + _self + {-# INLINE rule124 #-} + rule124 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule125 #-} + rule125 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Declaration_Type #-} +sem_Declaration_Type :: T_Range -> T_SimpleType -> T_Type -> T_Declaration +sem_Declaration_Type arg_range_ arg_simpletype_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_SimpleType_vOut151 _simpletypeIconstraints _simpletypeIdeclared _simpletypeIenvironment _simpletypeIkappaUnique _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 _simpletypeOconstraints _simpletypeOkappaOfRHS _simpletypeOkappaUnique) + (T_Type_vOut163 _typeIassumptions _typeIconstraints _typeIkappa _typeIkappaUnique _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOconstraints _typeOkappaUnique) + _simpletypeOconstraints = rule126 () + _simpletypeOkappaOfRHS = rule127 _typeIkappa + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule128 _lhsIbindingGroups _newGroup + _newConstraints = rule129 _simpletypeIenvironment _typeIassumptions + _newGroup = rule130 _newConstraints _simpletypeIdeclared _typeIassumptions _typeIconstraints + _self = rule131 _rangeIself _simpletypeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule132 _self + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule133 _typeIkappaUnique + _simpletypeOkappaUnique = rule134 _lhsIkappaUnique + _typeOconstraints = rule135 _simpletypeIconstraints + _typeOkappaUnique = rule136 _simpletypeIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule126 #-} + rule126 = \ (_ :: ()) -> + [] + {-# INLINE rule127 #-} + rule127 = \ ((_typeIkappa) :: Kind) -> + _typeIkappa + {-# INLINE rule128 #-} + rule128 = \ ((_lhsIbindingGroups) :: BindingGroups) _newGroup -> + _newGroup : _lhsIbindingGroups + {-# INLINE rule129 #-} + rule129 = \ ((_simpletypeIenvironment) :: PatternAssumptions) ((_typeIassumptions) :: Assumptions) -> + fst $ (_simpletypeIenvironment .===. _typeIassumptions) (\n -> unexpected $ "Declaration.Type " ++ show n) + {-# INLINE rule130 #-} + rule130 = \ _newConstraints ((_simpletypeIdeclared) :: PatternAssumptions) ((_typeIassumptions) :: Assumptions) ((_typeIconstraints) :: KindConstraints) -> + (_simpletypeIdeclared, _typeIassumptions, _newConstraints ++ _typeIconstraints) + {-# INLINE rule131 #-} + rule131 = \ ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_typeIself) :: Type) -> + Declaration_Type _rangeIself _simpletypeIself _typeIself + {-# INLINE rule132 #-} + rule132 = \ _self -> + _self + {-# INLINE rule133 #-} + rule133 = \ ((_typeIkappaUnique) :: Int) -> + _typeIkappaUnique + {-# INLINE rule134 #-} + rule134 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule135 #-} + rule135 = \ ((_simpletypeIconstraints) :: KindConstraints) -> + _simpletypeIconstraints + {-# INLINE rule136 #-} + rule136 = \ ((_simpletypeIkappaUnique) :: Int) -> + _simpletypeIkappaUnique +{-# NOINLINE sem_Declaration_Data #-} +sem_Declaration_Data :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructors -> T_Names -> T_Declaration +sem_Declaration_Data arg_range_ arg_context_ arg_simpletype_ arg_constructors_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorsX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_constructors_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIkappaUnique _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 _contextOkappaUnique) + (T_SimpleType_vOut151 _simpletypeIconstraints _simpletypeIdeclared _simpletypeIenvironment _simpletypeIkappaUnique _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 _simpletypeOconstraints _simpletypeOkappaOfRHS _simpletypeOkappaUnique) + (T_Constructors_vOut19 _constructorsIassumptions _constructorsIconstraints _constructorsIkappaUnique _constructorsIself) = inv_Constructors_s20 _constructorsX20 (T_Constructors_vIn19 _constructorsOconstraints _constructorsOkappaUnique) + (T_Names_vOut115 _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _simpletypeOconstraints = rule137 () + _simpletypeOkappaOfRHS = rule138 () + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule139 _lhsIbindingGroups _newGroup + _newConstraints = rule140 _constructorsIassumptions _simpletypeIenvironment + _newGroup = rule141 _constructorsIassumptions _constructorsIconstraints _newConstraints _simpletypeIdeclared + _self = rule142 _constructorsIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule143 _self + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule144 _constructorsIkappaUnique + _contextOkappaUnique = rule145 _lhsIkappaUnique + _simpletypeOkappaUnique = rule146 _contextIkappaUnique + _constructorsOconstraints = rule147 _simpletypeIconstraints + _constructorsOkappaUnique = rule148 _simpletypeIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule137 #-} + rule137 = \ (_ :: ()) -> + [] + {-# INLINE rule138 #-} + rule138 = \ (_ :: ()) -> + star + {-# INLINE rule139 #-} + rule139 = \ ((_lhsIbindingGroups) :: BindingGroups) _newGroup -> + _newGroup : _lhsIbindingGroups + {-# INLINE rule140 #-} + rule140 = \ ((_constructorsIassumptions) :: Assumptions) ((_simpletypeIenvironment) :: PatternAssumptions) -> + fst $ (_simpletypeIenvironment .===. _constructorsIassumptions) (\n -> unexpected $ "Declaration.Data " ++ show n) + {-# INLINE rule141 #-} + rule141 = \ ((_constructorsIassumptions) :: Assumptions) ((_constructorsIconstraints) :: KindConstraints) _newConstraints ((_simpletypeIdeclared) :: PatternAssumptions) -> + (_simpletypeIdeclared, _constructorsIassumptions, _newConstraints ++ _constructorsIconstraints) + {-# INLINE rule142 #-} + rule142 = \ ((_constructorsIself) :: Constructors) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Data _rangeIself _contextIself _simpletypeIself _constructorsIself _derivingsIself + {-# INLINE rule143 #-} + rule143 = \ _self -> + _self + {-# INLINE rule144 #-} + rule144 = \ ((_constructorsIkappaUnique) :: Int) -> + _constructorsIkappaUnique + {-# INLINE rule145 #-} + rule145 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule146 #-} + rule146 = \ ((_contextIkappaUnique) :: Int) -> + _contextIkappaUnique + {-# INLINE rule147 #-} + rule147 = \ ((_simpletypeIconstraints) :: KindConstraints) -> + _simpletypeIconstraints + {-# INLINE rule148 #-} + rule148 = \ ((_simpletypeIkappaUnique) :: Int) -> + _simpletypeIkappaUnique +{-# NOINLINE sem_Declaration_Newtype #-} +sem_Declaration_Newtype :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructor -> T_Names -> T_Declaration +sem_Declaration_Newtype arg_range_ arg_context_ arg_simpletype_ arg_constructor_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_constructor_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIkappaUnique _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 _contextOkappaUnique) + (T_SimpleType_vOut151 _simpletypeIconstraints _simpletypeIdeclared _simpletypeIenvironment _simpletypeIkappaUnique _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 _simpletypeOconstraints _simpletypeOkappaOfRHS _simpletypeOkappaUnique) + (T_Constructor_vOut16 _constructorIassumptions _constructorIconstraints _constructorIkappaUnique _constructorIself) = inv_Constructor_s17 _constructorX17 (T_Constructor_vIn16 _constructorOconstraints _constructorOkappaUnique) + (T_Names_vOut115 _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + (_constraints,_kappaOfRHS) = rule149 () + _self = rule150 _constructorIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule151 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule152 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule153 _constructorIkappaUnique + _contextOkappaUnique = rule154 _lhsIkappaUnique + _simpletypeOconstraints = rule155 _constraints + _simpletypeOkappaOfRHS = rule156 _kappaOfRHS + _simpletypeOkappaUnique = rule157 _contextIkappaUnique + _constructorOconstraints = rule158 _constraints + _constructorOkappaUnique = rule159 _simpletypeIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule149 #-} + rule149 = \ (_ :: ()) -> + internalError "KindInferencing.ag" "n/a" "newtype decls are not supported" + {-# INLINE rule150 #-} + rule150 = \ ((_constructorIself) :: Constructor) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Newtype _rangeIself _contextIself _simpletypeIself _constructorIself _derivingsIself + {-# INLINE rule151 #-} + rule151 = \ _self -> + _self + {-# INLINE rule152 #-} + rule152 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule153 #-} + rule153 = \ ((_constructorIkappaUnique) :: Int) -> + _constructorIkappaUnique + {-# INLINE rule154 #-} + rule154 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule155 #-} + rule155 = \ _constraints -> + _constraints + {-# INLINE rule156 #-} + rule156 = \ _kappaOfRHS -> + _kappaOfRHS + {-# INLINE rule157 #-} + rule157 = \ ((_contextIkappaUnique) :: Int) -> + _contextIkappaUnique + {-# INLINE rule158 #-} + rule158 = \ _constraints -> + _constraints + {-# INLINE rule159 #-} + rule159 = \ ((_simpletypeIkappaUnique) :: Int) -> + _simpletypeIkappaUnique +{-# NOINLINE sem_Declaration_Class #-} +sem_Declaration_Class :: T_Range -> T_ContextItems -> T_SimpleType -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Class arg_range_ arg_context_ arg_simpletype_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIkappaUnique _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 _contextOkappaUnique) + (T_SimpleType_vOut151 _simpletypeIconstraints _simpletypeIdeclared _simpletypeIenvironment _simpletypeIkappaUnique _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 _simpletypeOconstraints _simpletypeOkappaOfRHS _simpletypeOkappaUnique) + (T_MaybeDeclarations_vOut88 _whereIbindingGroups _whereIkappaUnique _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereObindingGroups _whereOkappaUnique) + (_constraints,_kappaOfRHS) = rule160 () + _self = rule161 _contextIself _rangeIself _simpletypeIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule162 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule163 _whereIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule164 _whereIkappaUnique + _contextOkappaUnique = rule165 _lhsIkappaUnique + _simpletypeOconstraints = rule166 _constraints + _simpletypeOkappaOfRHS = rule167 _kappaOfRHS + _simpletypeOkappaUnique = rule168 _contextIkappaUnique + _whereObindingGroups = rule169 _lhsIbindingGroups + _whereOkappaUnique = rule170 _simpletypeIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule160 #-} + rule160 = \ (_ :: ()) -> + internalError "KindInferencing.ag" "n/a" "class decls are not supported" + {-# INLINE rule161 #-} + rule161 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Class _rangeIself _contextIself _simpletypeIself _whereIself + {-# INLINE rule162 #-} + rule162 = \ _self -> + _self + {-# INLINE rule163 #-} + rule163 = \ ((_whereIbindingGroups) :: BindingGroups) -> + _whereIbindingGroups + {-# INLINE rule164 #-} + rule164 = \ ((_whereIkappaUnique) :: Int) -> + _whereIkappaUnique + {-# INLINE rule165 #-} + rule165 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule166 #-} + rule166 = \ _constraints -> + _constraints + {-# INLINE rule167 #-} + rule167 = \ _kappaOfRHS -> + _kappaOfRHS + {-# INLINE rule168 #-} + rule168 = \ ((_contextIkappaUnique) :: Int) -> + _contextIkappaUnique + {-# INLINE rule169 #-} + rule169 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule170 #-} + rule170 = \ ((_simpletypeIkappaUnique) :: Int) -> + _simpletypeIkappaUnique +{-# NOINLINE sem_Declaration_Instance #-} +sem_Declaration_Instance :: T_Range -> T_ContextItems -> T_Name -> T_Types -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Instance arg_range_ arg_context_ arg_name_ arg_types_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIkappaUnique _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 _contextOkappaUnique) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIassumptions _typesIconstraints _typesIkappaUnique _typesIkappas _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 _typesOconstraints _typesOkappaUnique) + (T_MaybeDeclarations_vOut88 _whereIbindingGroups _whereIkappaUnique _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereObindingGroups _whereOkappaUnique) + _constraints = rule171 () + _self = rule172 _contextIself _nameIself _rangeIself _typesIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule173 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule174 _whereIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule175 _whereIkappaUnique + _contextOkappaUnique = rule176 _lhsIkappaUnique + _typesOconstraints = rule177 _constraints + _typesOkappaUnique = rule178 _contextIkappaUnique + _whereObindingGroups = rule179 _lhsIbindingGroups + _whereOkappaUnique = rule180 _typesIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule171 #-} + rule171 = \ (_ :: ()) -> + internalError "KindInferencing.ag" "n/a" "instance decls are not supported" + {-# INLINE rule172 #-} + rule172 = \ ((_contextIself) :: ContextItems) ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Instance _rangeIself _contextIself _nameIself _typesIself _whereIself + {-# INLINE rule173 #-} + rule173 = \ _self -> + _self + {-# INLINE rule174 #-} + rule174 = \ ((_whereIbindingGroups) :: BindingGroups) -> + _whereIbindingGroups + {-# INLINE rule175 #-} + rule175 = \ ((_whereIkappaUnique) :: Int) -> + _whereIkappaUnique + {-# INLINE rule176 #-} + rule176 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule177 #-} + rule177 = \ _constraints -> + _constraints + {-# INLINE rule178 #-} + rule178 = \ ((_contextIkappaUnique) :: Int) -> + _contextIkappaUnique + {-# INLINE rule179 #-} + rule179 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule180 #-} + rule180 = \ ((_typesIkappaUnique) :: Int) -> + _typesIkappaUnique +{-# NOINLINE sem_Declaration_Default #-} +sem_Declaration_Default :: T_Range -> T_Types -> T_Declaration +sem_Declaration_Default arg_range_ arg_types_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Types_vOut166 _typesIassumptions _typesIconstraints _typesIkappaUnique _typesIkappas _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 _typesOconstraints _typesOkappaUnique) + _constraints = rule181 () + _self = rule182 _rangeIself _typesIself + _lhsOself :: Declaration + _lhsOself = rule183 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule184 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule185 _typesIkappaUnique + _typesOconstraints = rule186 _constraints + _typesOkappaUnique = rule187 _lhsIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule181 #-} + rule181 = \ (_ :: ()) -> + internalError "KindInferencing.ag" "n/a" "default decls is not supported" + {-# INLINE rule182 #-} + rule182 = \ ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + Declaration_Default _rangeIself _typesIself + {-# INLINE rule183 #-} + rule183 = \ _self -> + _self + {-# INLINE rule184 #-} + rule184 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule185 #-} + rule185 = \ ((_typesIkappaUnique) :: Int) -> + _typesIkappaUnique + {-# INLINE rule186 #-} + rule186 = \ _constraints -> + _constraints + {-# INLINE rule187 #-} + rule187 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Declaration_FunctionBindings #-} +sem_Declaration_FunctionBindings :: T_Range -> T_FunctionBindings -> T_Declaration +sem_Declaration_FunctionBindings arg_range_ arg_bindings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _bindingsX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_bindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBindings_vOut58 _bindingsIbindingGroups _bindingsIkappaUnique _bindingsIself) = inv_FunctionBindings_s59 _bindingsX59 (T_FunctionBindings_vIn58 _bindingsObindingGroups _bindingsOkappaUnique) + _self = rule188 _bindingsIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule189 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule190 _bindingsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule191 _bindingsIkappaUnique + _bindingsObindingGroups = rule192 _lhsIbindingGroups + _bindingsOkappaUnique = rule193 _lhsIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule188 #-} + rule188 = \ ((_bindingsIself) :: FunctionBindings) ((_rangeIself) :: Range) -> + Declaration_FunctionBindings _rangeIself _bindingsIself + {-# INLINE rule189 #-} + rule189 = \ _self -> + _self + {-# INLINE rule190 #-} + rule190 = \ ((_bindingsIbindingGroups) :: BindingGroups) -> + _bindingsIbindingGroups + {-# INLINE rule191 #-} + rule191 = \ ((_bindingsIkappaUnique) :: Int) -> + _bindingsIkappaUnique + {-# INLINE rule192 #-} + rule192 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule193 #-} + rule193 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Declaration_PatternBinding #-} +sem_Declaration_PatternBinding :: T_Range -> T_Pattern -> T_RightHandSide -> T_Declaration +sem_Declaration_PatternBinding arg_range_ arg_pattern_ arg_righthandside_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_RightHandSide_vOut148 _righthandsideIbindingGroups _righthandsideIkappaUnique _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideObindingGroups _righthandsideOkappaUnique) + _self = rule194 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Declaration + _lhsOself = rule195 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule196 _righthandsideIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule197 _righthandsideIkappaUnique + _righthandsideObindingGroups = rule198 _lhsIbindingGroups + _righthandsideOkappaUnique = rule199 _lhsIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule194 #-} + rule194 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Declaration_PatternBinding _rangeIself _patternIself _righthandsideIself + {-# INLINE rule195 #-} + rule195 = \ _self -> + _self + {-# INLINE rule196 #-} + rule196 = \ ((_righthandsideIbindingGroups) :: BindingGroups) -> + _righthandsideIbindingGroups + {-# INLINE rule197 #-} + rule197 = \ ((_righthandsideIkappaUnique) :: Int) -> + _righthandsideIkappaUnique + {-# INLINE rule198 #-} + rule198 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule199 #-} + rule199 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Declaration_TypeSignature #-} +sem_Declaration_TypeSignature :: T_Range -> T_Names -> T_Type -> T_Declaration +sem_Declaration_TypeSignature arg_range_ arg_names_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIassumptions _typeIconstraints _typeIkappa _typeIkappaUnique _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOconstraints _typeOkappaUnique) + _typeOconstraints = rule200 () + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule201 _lhsIbindingGroups _newGroup + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule202 _tvEnv _typeIkappaUnique + _newConstraint = rule203 _rangeIself _typeIkappa _typeIself + _tvEnv = rule204 _typeIassumptions _typeIkappaUnique + (_cset,_aset) = rule205 _tvEnv _typeIassumptions + _newGroup = rule206 _aset _cset _newConstraint _typeIconstraints + _self = rule207 _namesIself _rangeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule208 _self + _typeOkappaUnique = rule209 _lhsIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule200 #-} + rule200 = \ (_ :: ()) -> + [] + {-# INLINE rule201 #-} + rule201 = \ ((_lhsIbindingGroups) :: BindingGroups) _newGroup -> + _newGroup : _lhsIbindingGroups + {-# INLINE rule202 #-} + rule202 = \ _tvEnv ((_typeIkappaUnique) :: Int) -> + _typeIkappaUnique + length _tvEnv + {-# INLINE rule203 #-} + rule203 = \ ((_rangeIself) :: Range) ((_typeIkappa) :: Kind) ((_typeIself) :: Type) -> + (_typeIkappa <==> star) (mustBeStar _rangeIself "type signature" _typeIself) + {-# INLINE rule204 #-} + rule204 = \ ((_typeIassumptions) :: Assumptions) ((_typeIkappaUnique) :: Int) -> + zip (getTypeVariables _typeIassumptions) (map TVar [_typeIkappaUnique..]) + {-# INLINE rule205 #-} + rule205 = \ _tvEnv ((_typeIassumptions) :: Assumptions) -> + (M.fromList _tvEnv .===. _typeIassumptions) (\n -> unexpected $ "Declaration.TypeSignature " ++ show n) + {-# INLINE rule206 #-} + rule206 = \ _aset _cset _newConstraint ((_typeIconstraints) :: KindConstraints) -> + (M.empty, _aset, _cset ++ _typeIconstraints ++ [_newConstraint]) + {-# INLINE rule207 #-} + rule207 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Declaration_TypeSignature _rangeIself _namesIself _typeIself + {-# INLINE rule208 #-} + rule208 = \ _self -> + _self + {-# INLINE rule209 #-} + rule209 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Declaration_Fixity #-} +sem_Declaration_Fixity :: T_Range -> T_Fixity -> T_MaybeInt -> T_Names -> T_Declaration +sem_Declaration_Fixity arg_range_ arg_fixity_ arg_priority_ arg_operators_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fixityX53 = Control.Monad.Identity.runIdentity (attach_T_Fixity (arg_fixity_)) + _priorityX101 = Control.Monad.Identity.runIdentity (attach_T_MaybeInt (arg_priority_)) + _operatorsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_operators_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Fixity_vOut52 _fixityIself) = inv_Fixity_s53 _fixityX53 (T_Fixity_vIn52 ) + (T_MaybeInt_vOut100 _priorityIself) = inv_MaybeInt_s101 _priorityX101 (T_MaybeInt_vIn100 ) + (T_Names_vOut115 _operatorsIself) = inv_Names_s116 _operatorsX116 (T_Names_vIn115 ) + _self = rule210 _fixityIself _operatorsIself _priorityIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule211 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule212 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule213 _lhsIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule210 #-} + rule210 = \ ((_fixityIself) :: Fixity) ((_operatorsIself) :: Names) ((_priorityIself) :: MaybeInt) ((_rangeIself) :: Range) -> + Declaration_Fixity _rangeIself _fixityIself _priorityIself _operatorsIself + {-# INLINE rule211 #-} + rule211 = \ _self -> + _self + {-# INLINE rule212 #-} + rule212 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule213 #-} + rule213 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Declaration_Empty #-} +sem_Declaration_Empty :: T_Range -> T_Declaration +sem_Declaration_Empty arg_range_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule214 _rangeIself + _lhsOself :: Declaration + _lhsOself = rule215 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule216 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule217 _lhsIkappaUnique + __result_ = T_Declaration_vOut28 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule214 #-} + rule214 = \ ((_rangeIself) :: Range) -> + Declaration_Empty _rangeIself + {-# INLINE rule215 #-} + rule215 = \ _self -> + _self + {-# INLINE rule216 #-} + rule216 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule217 #-} + rule217 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Declarations ------------------------------------------------ +-- wrapper +data Inh_Declarations = Inh_Declarations { bindingGroups_Inh_Declarations :: (BindingGroups), kappaUnique_Inh_Declarations :: (Int) } +data Syn_Declarations = Syn_Declarations { bindingGroups_Syn_Declarations :: (BindingGroups), kappaUnique_Syn_Declarations :: (Int), self_Syn_Declarations :: (Declarations) } +{-# INLINABLE wrap_Declarations #-} +wrap_Declarations :: T_Declarations -> Inh_Declarations -> (Syn_Declarations ) +wrap_Declarations (T_Declarations act) (Inh_Declarations _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declarations_vIn31 _lhsIbindingGroups _lhsIkappaUnique + (T_Declarations_vOut31 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_Declarations_s32 sem arg) + return (Syn_Declarations _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declarations #-} +sem_Declarations :: Declarations -> T_Declarations +sem_Declarations list = Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list) + +-- semantic domain +newtype T_Declarations = T_Declarations { + attach_T_Declarations :: Identity (T_Declarations_s32 ) + } +newtype T_Declarations_s32 = C_Declarations_s32 { + inv_Declarations_s32 :: (T_Declarations_v31 ) + } +data T_Declarations_s33 = C_Declarations_s33 +type T_Declarations_v31 = (T_Declarations_vIn31 ) -> (T_Declarations_vOut31 ) +data T_Declarations_vIn31 = T_Declarations_vIn31 (BindingGroups) (Int) +data T_Declarations_vOut31 = T_Declarations_vOut31 (BindingGroups) (Int) (Declarations) +{-# NOINLINE sem_Declarations_Cons #-} +sem_Declarations_Cons :: T_Declaration -> T_Declarations -> T_Declarations +sem_Declarations_Cons arg_hd_ arg_tl_ = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Declaration (arg_hd_)) + _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_tl_)) + (T_Declaration_vOut28 _hdIbindingGroups _hdIkappaUnique _hdIself) = inv_Declaration_s29 _hdX29 (T_Declaration_vIn28 _hdObindingGroups _hdOkappaUnique) + (T_Declarations_vOut31 _tlIbindingGroups _tlIkappaUnique _tlIself) = inv_Declarations_s32 _tlX32 (T_Declarations_vIn31 _tlObindingGroups _tlOkappaUnique) + _self = rule218 _hdIself _tlIself + _lhsOself :: Declarations + _lhsOself = rule219 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule220 _tlIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule221 _tlIkappaUnique + _hdObindingGroups = rule222 _lhsIbindingGroups + _hdOkappaUnique = rule223 _lhsIkappaUnique + _tlObindingGroups = rule224 _hdIbindingGroups + _tlOkappaUnique = rule225 _hdIkappaUnique + __result_ = T_Declarations_vOut31 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule218 #-} + rule218 = \ ((_hdIself) :: Declaration) ((_tlIself) :: Declarations) -> + (:) _hdIself _tlIself + {-# INLINE rule219 #-} + rule219 = \ _self -> + _self + {-# INLINE rule220 #-} + rule220 = \ ((_tlIbindingGroups) :: BindingGroups) -> + _tlIbindingGroups + {-# INLINE rule221 #-} + rule221 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule222 #-} + rule222 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule223 #-} + rule223 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule224 #-} + rule224 = \ ((_hdIbindingGroups) :: BindingGroups) -> + _hdIbindingGroups + {-# INLINE rule225 #-} + rule225 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_Declarations_Nil #-} +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _self = rule226 () + _lhsOself :: Declarations + _lhsOself = rule227 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule228 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule229 _lhsIkappaUnique + __result_ = T_Declarations_vOut31 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule226 #-} + rule226 = \ (_ :: ()) -> + [] + {-# INLINE rule227 #-} + rule227 = \ _self -> + _self + {-# INLINE rule228 #-} + rule228 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule229 #-} + rule229 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Export ------------------------------------------------------ +-- wrapper +data Inh_Export = Inh_Export { } +data Syn_Export = Syn_Export { self_Syn_Export :: (Export) } +{-# INLINABLE wrap_Export #-} +wrap_Export :: T_Export -> Inh_Export -> (Syn_Export ) +wrap_Export (T_Export act) (Inh_Export ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Export_vIn34 + (T_Export_vOut34 _lhsOself) <- return (inv_Export_s35 sem arg) + return (Syn_Export _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Export #-} +sem_Export :: Export -> T_Export +sem_Export ( Export_Variable range_ name_ ) = sem_Export_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_TypeOrClass range_ name_ names_ ) = sem_Export_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Export ( Export_TypeOrClassComplete range_ name_ ) = sem_Export_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_Module range_ name_ ) = sem_Export_Module ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Export = T_Export { + attach_T_Export :: Identity (T_Export_s35 ) + } +newtype T_Export_s35 = C_Export_s35 { + inv_Export_s35 :: (T_Export_v34 ) + } +data T_Export_s36 = C_Export_s36 +type T_Export_v34 = (T_Export_vIn34 ) -> (T_Export_vOut34 ) +data T_Export_vIn34 = T_Export_vIn34 +data T_Export_vOut34 = T_Export_vOut34 (Export) +{-# NOINLINE sem_Export_Variable #-} +sem_Export_Variable :: T_Range -> T_Name -> T_Export +sem_Export_Variable arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule230 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule231 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule230 #-} + rule230 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Variable _rangeIself _nameIself + {-# INLINE rule231 #-} + rule231 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClass #-} +sem_Export_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Export +sem_Export_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _self = rule232 _nameIself _namesIself _rangeIself + _lhsOself :: Export + _lhsOself = rule233 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule232 #-} + rule232 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Export_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule233 #-} + rule233 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClassComplete #-} +sem_Export_TypeOrClassComplete :: T_Range -> T_Name -> T_Export +sem_Export_TypeOrClassComplete arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule234 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule235 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule234 #-} + rule234 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule235 #-} + rule235 = \ _self -> + _self +{-# NOINLINE sem_Export_Module #-} +sem_Export_Module :: T_Range -> T_Name -> T_Export +sem_Export_Module arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule236 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule237 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule236 #-} + rule236 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Module _rangeIself _nameIself + {-# INLINE rule237 #-} + rule237 = \ _self -> + _self + +-- Exports ----------------------------------------------------- +-- wrapper +data Inh_Exports = Inh_Exports { } +data Syn_Exports = Syn_Exports { self_Syn_Exports :: (Exports) } +{-# INLINABLE wrap_Exports #-} +wrap_Exports :: T_Exports -> Inh_Exports -> (Syn_Exports ) +wrap_Exports (T_Exports act) (Inh_Exports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Exports_vIn37 + (T_Exports_vOut37 _lhsOself) <- return (inv_Exports_s38 sem arg) + return (Syn_Exports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Exports #-} +sem_Exports :: Exports -> T_Exports +sem_Exports list = Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list) + +-- semantic domain +newtype T_Exports = T_Exports { + attach_T_Exports :: Identity (T_Exports_s38 ) + } +newtype T_Exports_s38 = C_Exports_s38 { + inv_Exports_s38 :: (T_Exports_v37 ) + } +data T_Exports_s39 = C_Exports_s39 +type T_Exports_v37 = (T_Exports_vIn37 ) -> (T_Exports_vOut37 ) +data T_Exports_vIn37 = T_Exports_vIn37 +data T_Exports_vOut37 = T_Exports_vOut37 (Exports) +{-# NOINLINE sem_Exports_Cons #-} +sem_Exports_Cons :: T_Export -> T_Exports -> T_Exports +sem_Exports_Cons arg_hd_ arg_tl_ = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Export (arg_hd_)) + _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_tl_)) + (T_Export_vOut34 _hdIself) = inv_Export_s35 _hdX35 (T_Export_vIn34 ) + (T_Exports_vOut37 _tlIself) = inv_Exports_s38 _tlX38 (T_Exports_vIn37 ) + _self = rule238 _hdIself _tlIself + _lhsOself :: Exports + _lhsOself = rule239 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule238 #-} + rule238 = \ ((_hdIself) :: Export) ((_tlIself) :: Exports) -> + (:) _hdIself _tlIself + {-# INLINE rule239 #-} + rule239 = \ _self -> + _self +{-# NOINLINE sem_Exports_Nil #-} +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _self = rule240 () + _lhsOself :: Exports + _lhsOself = rule241 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule240 #-} + rule240 = \ (_ :: ()) -> + [] + {-# INLINE rule241 #-} + rule241 = \ _self -> + _self + +-- Expression -------------------------------------------------- +-- wrapper +data Inh_Expression = Inh_Expression { bindingGroups_Inh_Expression :: (BindingGroups), kappaUnique_Inh_Expression :: (Int) } +data Syn_Expression = Syn_Expression { bindingGroups_Syn_Expression :: (BindingGroups), kappaUnique_Syn_Expression :: (Int), self_Syn_Expression :: (Expression) } +{-# INLINABLE wrap_Expression #-} +wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) +wrap_Expression (T_Expression act) (Inh_Expression _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique + (T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_Expression_s41 sem arg) + return (Syn_Expression _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expression #-} +sem_Expression :: Expression -> T_Expression +sem_Expression ( Expression_Hole range_ id_ ) = sem_Expression_Hole ( sem_Range range_ ) id_ +sem_Expression ( Expression_Feedback range_ feedback_ expression_ ) = sem_Expression_Feedback ( sem_Range range_ ) feedback_ ( sem_Expression expression_ ) +sem_Expression ( Expression_MustUse range_ expression_ ) = sem_Expression_MustUse ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Literal range_ literal_ ) = sem_Expression_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Expression ( Expression_Variable range_ name_ ) = sem_Expression_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Constructor range_ name_ ) = sem_Expression_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Parenthesized range_ expression_ ) = sem_Expression_Parenthesized ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NormalApplication range_ function_ arguments_ ) = sem_Expression_NormalApplication ( sem_Range range_ ) ( sem_Expression function_ ) ( sem_Expressions arguments_ ) +sem_Expression ( Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ ) = sem_Expression_InfixApplication ( sem_Range range_ ) ( sem_MaybeExpression leftExpression_ ) ( sem_Expression operator_ ) ( sem_MaybeExpression rightExpression_ ) +sem_Expression ( Expression_If range_ guardExpression_ thenExpression_ elseExpression_ ) = sem_Expression_If ( sem_Range range_ ) ( sem_Expression guardExpression_ ) ( sem_Expression thenExpression_ ) ( sem_Expression elseExpression_ ) +sem_Expression ( Expression_Lambda range_ patterns_ expression_ ) = sem_Expression_Lambda ( sem_Range range_ ) ( sem_Patterns patterns_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Case range_ expression_ alternatives_ ) = sem_Expression_Case ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Alternatives alternatives_ ) +sem_Expression ( Expression_Let range_ declarations_ expression_ ) = sem_Expression_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Do range_ statements_ ) = sem_Expression_Do ( sem_Range range_ ) ( sem_Statements statements_ ) +sem_Expression ( Expression_List range_ expressions_ ) = sem_Expression_List ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Tuple range_ expressions_ ) = sem_Expression_Tuple ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Comprehension range_ expression_ qualifiers_ ) = sem_Expression_Comprehension ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Qualifiers qualifiers_ ) +sem_Expression ( Expression_Typed range_ expression_ type_ ) = sem_Expression_Typed ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Type type_ ) +sem_Expression ( Expression_RecordConstruction range_ name_ recordExpressionBindings_ ) = sem_Expression_RecordConstruction ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_RecordUpdate range_ expression_ recordExpressionBindings_ ) = sem_Expression_RecordUpdate ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_Enum range_ from_ then_ to_ ) = sem_Expression_Enum ( sem_Range range_ ) ( sem_Expression from_ ) ( sem_MaybeExpression then_ ) ( sem_MaybeExpression to_ ) +sem_Expression ( Expression_Negate range_ expression_ ) = sem_Expression_Negate ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NegateFloat range_ expression_ ) = sem_Expression_NegateFloat ( sem_Range range_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_Expression = T_Expression { + attach_T_Expression :: Identity (T_Expression_s41 ) + } +newtype T_Expression_s41 = C_Expression_s41 { + inv_Expression_s41 :: (T_Expression_v40 ) + } +data T_Expression_s42 = C_Expression_s42 +type T_Expression_v40 = (T_Expression_vIn40 ) -> (T_Expression_vOut40 ) +data T_Expression_vIn40 = T_Expression_vIn40 (BindingGroups) (Int) +data T_Expression_vOut40 = T_Expression_vOut40 (BindingGroups) (Int) (Expression) +{-# NOINLINE sem_Expression_Hole #-} +sem_Expression_Hole :: T_Range -> (Integer) -> T_Expression +sem_Expression_Hole arg_range_ arg_id_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule242 _rangeIself arg_id_ + _lhsOself :: Expression + _lhsOself = rule243 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule244 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule245 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule242 #-} + rule242 = \ ((_rangeIself) :: Range) id_ -> + Expression_Hole _rangeIself id_ + {-# INLINE rule243 #-} + rule243 = \ _self -> + _self + {-# INLINE rule244 #-} + rule244 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule245 #-} + rule245 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_Feedback #-} +sem_Expression_Feedback :: T_Range -> (String) -> T_Expression -> T_Expression +sem_Expression_Feedback arg_range_ arg_feedback_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule246 _expressionIself _rangeIself arg_feedback_ + _lhsOself :: Expression + _lhsOself = rule247 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule248 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule249 _expressionIkappaUnique + _expressionObindingGroups = rule250 _lhsIbindingGroups + _expressionOkappaUnique = rule251 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule246 #-} + rule246 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) feedback_ -> + Expression_Feedback _rangeIself feedback_ _expressionIself + {-# INLINE rule247 #-} + rule247 = \ _self -> + _self + {-# INLINE rule248 #-} + rule248 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule249 #-} + rule249 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule250 #-} + rule250 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule251 #-} + rule251 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_MustUse #-} +sem_Expression_MustUse :: T_Range -> T_Expression -> T_Expression +sem_Expression_MustUse arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule252 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule253 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule254 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule255 _expressionIkappaUnique + _expressionObindingGroups = rule256 _lhsIbindingGroups + _expressionOkappaUnique = rule257 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule252 #-} + rule252 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_MustUse _rangeIself _expressionIself + {-# INLINE rule253 #-} + rule253 = \ _self -> + _self + {-# INLINE rule254 #-} + rule254 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule255 #-} + rule255 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule256 #-} + rule256 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule257 #-} + rule257 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_Literal #-} +sem_Expression_Literal :: T_Range -> T_Literal -> T_Expression +sem_Expression_Literal arg_range_ arg_literal_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule258 _literalIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule259 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule260 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule261 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule258 #-} + rule258 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Expression_Literal _rangeIself _literalIself + {-# INLINE rule259 #-} + rule259 = \ _self -> + _self + {-# INLINE rule260 #-} + rule260 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule261 #-} + rule261 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_Variable #-} +sem_Expression_Variable :: T_Range -> T_Name -> T_Expression +sem_Expression_Variable arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule262 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule263 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule264 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule265 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule262 #-} + rule262 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Variable _rangeIself _nameIself + {-# INLINE rule263 #-} + rule263 = \ _self -> + _self + {-# INLINE rule264 #-} + rule264 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule265 #-} + rule265 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_Constructor #-} +sem_Expression_Constructor :: T_Range -> T_Name -> T_Expression +sem_Expression_Constructor arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule266 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule267 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule268 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule269 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule266 #-} + rule266 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Constructor _rangeIself _nameIself + {-# INLINE rule267 #-} + rule267 = \ _self -> + _self + {-# INLINE rule268 #-} + rule268 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule269 #-} + rule269 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_Parenthesized #-} +sem_Expression_Parenthesized :: T_Range -> T_Expression -> T_Expression +sem_Expression_Parenthesized arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule270 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule271 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule272 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule273 _expressionIkappaUnique + _expressionObindingGroups = rule274 _lhsIbindingGroups + _expressionOkappaUnique = rule275 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule270 #-} + rule270 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Parenthesized _rangeIself _expressionIself + {-# INLINE rule271 #-} + rule271 = \ _self -> + _self + {-# INLINE rule272 #-} + rule272 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule273 #-} + rule273 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule274 #-} + rule274 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule275 #-} + rule275 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_NormalApplication #-} +sem_Expression_NormalApplication :: T_Range -> T_Expression -> T_Expressions -> T_Expression +sem_Expression_NormalApplication arg_range_ arg_function_ arg_arguments_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_function_)) + _argumentsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _functionIbindingGroups _functionIkappaUnique _functionIself) = inv_Expression_s41 _functionX41 (T_Expression_vIn40 _functionObindingGroups _functionOkappaUnique) + (T_Expressions_vOut43 _argumentsIbindingGroups _argumentsIkappaUnique _argumentsIself) = inv_Expressions_s44 _argumentsX44 (T_Expressions_vIn43 _argumentsObindingGroups _argumentsOkappaUnique) + _self = rule276 _argumentsIself _functionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule277 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule278 _argumentsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule279 _argumentsIkappaUnique + _functionObindingGroups = rule280 _lhsIbindingGroups + _functionOkappaUnique = rule281 _lhsIkappaUnique + _argumentsObindingGroups = rule282 _functionIbindingGroups + _argumentsOkappaUnique = rule283 _functionIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule276 #-} + rule276 = \ ((_argumentsIself) :: Expressions) ((_functionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NormalApplication _rangeIself _functionIself _argumentsIself + {-# INLINE rule277 #-} + rule277 = \ _self -> + _self + {-# INLINE rule278 #-} + rule278 = \ ((_argumentsIbindingGroups) :: BindingGroups) -> + _argumentsIbindingGroups + {-# INLINE rule279 #-} + rule279 = \ ((_argumentsIkappaUnique) :: Int) -> + _argumentsIkappaUnique + {-# INLINE rule280 #-} + rule280 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule281 #-} + rule281 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule282 #-} + rule282 = \ ((_functionIbindingGroups) :: BindingGroups) -> + _functionIbindingGroups + {-# INLINE rule283 #-} + rule283 = \ ((_functionIkappaUnique) :: Int) -> + _functionIkappaUnique +{-# NOINLINE sem_Expression_InfixApplication #-} +sem_Expression_InfixApplication :: T_Range -> T_MaybeExpression -> T_Expression -> T_MaybeExpression -> T_Expression +sem_Expression_InfixApplication arg_range_ arg_leftExpression_ arg_operator_ arg_rightExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_leftExpression_)) + _operatorX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_operator_)) + _rightExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_rightExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeExpression_vOut94 _leftExpressionIbindingGroups _leftExpressionIkappaUnique _leftExpressionIself) = inv_MaybeExpression_s95 _leftExpressionX95 (T_MaybeExpression_vIn94 _leftExpressionObindingGroups _leftExpressionOkappaUnique) + (T_Expression_vOut40 _operatorIbindingGroups _operatorIkappaUnique _operatorIself) = inv_Expression_s41 _operatorX41 (T_Expression_vIn40 _operatorObindingGroups _operatorOkappaUnique) + (T_MaybeExpression_vOut94 _rightExpressionIbindingGroups _rightExpressionIkappaUnique _rightExpressionIself) = inv_MaybeExpression_s95 _rightExpressionX95 (T_MaybeExpression_vIn94 _rightExpressionObindingGroups _rightExpressionOkappaUnique) + _self = rule284 _leftExpressionIself _operatorIself _rangeIself _rightExpressionIself + _lhsOself :: Expression + _lhsOself = rule285 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule286 _rightExpressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule287 _rightExpressionIkappaUnique + _leftExpressionObindingGroups = rule288 _lhsIbindingGroups + _leftExpressionOkappaUnique = rule289 _lhsIkappaUnique + _operatorObindingGroups = rule290 _leftExpressionIbindingGroups + _operatorOkappaUnique = rule291 _leftExpressionIkappaUnique + _rightExpressionObindingGroups = rule292 _operatorIbindingGroups + _rightExpressionOkappaUnique = rule293 _operatorIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule284 #-} + rule284 = \ ((_leftExpressionIself) :: MaybeExpression) ((_operatorIself) :: Expression) ((_rangeIself) :: Range) ((_rightExpressionIself) :: MaybeExpression) -> + Expression_InfixApplication _rangeIself _leftExpressionIself _operatorIself _rightExpressionIself + {-# INLINE rule285 #-} + rule285 = \ _self -> + _self + {-# INLINE rule286 #-} + rule286 = \ ((_rightExpressionIbindingGroups) :: BindingGroups) -> + _rightExpressionIbindingGroups + {-# INLINE rule287 #-} + rule287 = \ ((_rightExpressionIkappaUnique) :: Int) -> + _rightExpressionIkappaUnique + {-# INLINE rule288 #-} + rule288 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule289 #-} + rule289 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule290 #-} + rule290 = \ ((_leftExpressionIbindingGroups) :: BindingGroups) -> + _leftExpressionIbindingGroups + {-# INLINE rule291 #-} + rule291 = \ ((_leftExpressionIkappaUnique) :: Int) -> + _leftExpressionIkappaUnique + {-# INLINE rule292 #-} + rule292 = \ ((_operatorIbindingGroups) :: BindingGroups) -> + _operatorIbindingGroups + {-# INLINE rule293 #-} + rule293 = \ ((_operatorIkappaUnique) :: Int) -> + _operatorIkappaUnique +{-# NOINLINE sem_Expression_If #-} +sem_Expression_If :: T_Range -> T_Expression -> T_Expression -> T_Expression -> T_Expression +sem_Expression_If arg_range_ arg_guardExpression_ arg_thenExpression_ arg_elseExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guardExpression_)) + _thenExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_thenExpression_)) + _elseExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_elseExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardExpressionIbindingGroups _guardExpressionIkappaUnique _guardExpressionIself) = inv_Expression_s41 _guardExpressionX41 (T_Expression_vIn40 _guardExpressionObindingGroups _guardExpressionOkappaUnique) + (T_Expression_vOut40 _thenExpressionIbindingGroups _thenExpressionIkappaUnique _thenExpressionIself) = inv_Expression_s41 _thenExpressionX41 (T_Expression_vIn40 _thenExpressionObindingGroups _thenExpressionOkappaUnique) + (T_Expression_vOut40 _elseExpressionIbindingGroups _elseExpressionIkappaUnique _elseExpressionIself) = inv_Expression_s41 _elseExpressionX41 (T_Expression_vIn40 _elseExpressionObindingGroups _elseExpressionOkappaUnique) + _self = rule294 _elseExpressionIself _guardExpressionIself _rangeIself _thenExpressionIself + _lhsOself :: Expression + _lhsOself = rule295 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule296 _elseExpressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule297 _elseExpressionIkappaUnique + _guardExpressionObindingGroups = rule298 _lhsIbindingGroups + _guardExpressionOkappaUnique = rule299 _lhsIkappaUnique + _thenExpressionObindingGroups = rule300 _guardExpressionIbindingGroups + _thenExpressionOkappaUnique = rule301 _guardExpressionIkappaUnique + _elseExpressionObindingGroups = rule302 _thenExpressionIbindingGroups + _elseExpressionOkappaUnique = rule303 _thenExpressionIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule294 #-} + rule294 = \ ((_elseExpressionIself) :: Expression) ((_guardExpressionIself) :: Expression) ((_rangeIself) :: Range) ((_thenExpressionIself) :: Expression) -> + Expression_If _rangeIself _guardExpressionIself _thenExpressionIself _elseExpressionIself + {-# INLINE rule295 #-} + rule295 = \ _self -> + _self + {-# INLINE rule296 #-} + rule296 = \ ((_elseExpressionIbindingGroups) :: BindingGroups) -> + _elseExpressionIbindingGroups + {-# INLINE rule297 #-} + rule297 = \ ((_elseExpressionIkappaUnique) :: Int) -> + _elseExpressionIkappaUnique + {-# INLINE rule298 #-} + rule298 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule299 #-} + rule299 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule300 #-} + rule300 = \ ((_guardExpressionIbindingGroups) :: BindingGroups) -> + _guardExpressionIbindingGroups + {-# INLINE rule301 #-} + rule301 = \ ((_guardExpressionIkappaUnique) :: Int) -> + _guardExpressionIkappaUnique + {-# INLINE rule302 #-} + rule302 = \ ((_thenExpressionIbindingGroups) :: BindingGroups) -> + _thenExpressionIbindingGroups + {-# INLINE rule303 #-} + rule303 = \ ((_thenExpressionIkappaUnique) :: Int) -> + _thenExpressionIkappaUnique +{-# NOINLINE sem_Expression_Lambda #-} +sem_Expression_Lambda :: T_Range -> T_Patterns -> T_Expression -> T_Expression +sem_Expression_Lambda arg_range_ arg_patterns_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule304 _expressionIself _patternsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule305 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule306 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule307 _expressionIkappaUnique + _expressionObindingGroups = rule308 _lhsIbindingGroups + _expressionOkappaUnique = rule309 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule304 #-} + rule304 = \ ((_expressionIself) :: Expression) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Expression_Lambda _rangeIself _patternsIself _expressionIself + {-# INLINE rule305 #-} + rule305 = \ _self -> + _self + {-# INLINE rule306 #-} + rule306 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule307 #-} + rule307 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule308 #-} + rule308 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule309 #-} + rule309 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_Case #-} +sem_Expression_Case :: T_Range -> T_Expression -> T_Alternatives -> T_Expression +sem_Expression_Case arg_range_ arg_expression_ arg_alternatives_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _alternativesX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_alternatives_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + (T_Alternatives_vOut4 _alternativesIbindingGroups _alternativesIkappaUnique _alternativesIself) = inv_Alternatives_s5 _alternativesX5 (T_Alternatives_vIn4 _alternativesObindingGroups _alternativesOkappaUnique) + _self = rule310 _alternativesIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule311 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule312 _alternativesIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule313 _alternativesIkappaUnique + _expressionObindingGroups = rule314 _lhsIbindingGroups + _expressionOkappaUnique = rule315 _lhsIkappaUnique + _alternativesObindingGroups = rule316 _expressionIbindingGroups + _alternativesOkappaUnique = rule317 _expressionIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule310 #-} + rule310 = \ ((_alternativesIself) :: Alternatives) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Case _rangeIself _expressionIself _alternativesIself + {-# INLINE rule311 #-} + rule311 = \ _self -> + _self + {-# INLINE rule312 #-} + rule312 = \ ((_alternativesIbindingGroups) :: BindingGroups) -> + _alternativesIbindingGroups + {-# INLINE rule313 #-} + rule313 = \ ((_alternativesIkappaUnique) :: Int) -> + _alternativesIkappaUnique + {-# INLINE rule314 #-} + rule314 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule315 #-} + rule315 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule316 #-} + rule316 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule317 #-} + rule317 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique +{-# NOINLINE sem_Expression_Let #-} +sem_Expression_Let :: T_Range -> T_Declarations -> T_Expression -> T_Expression +sem_Expression_Let arg_range_ arg_declarations_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIbindingGroups _declarationsIkappaUnique _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsObindingGroups _declarationsOkappaUnique) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule318 _declarationsIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule319 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule320 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule321 _expressionIkappaUnique + _declarationsObindingGroups = rule322 _lhsIbindingGroups + _declarationsOkappaUnique = rule323 _lhsIkappaUnique + _expressionObindingGroups = rule324 _declarationsIbindingGroups + _expressionOkappaUnique = rule325 _declarationsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule318 #-} + rule318 = \ ((_declarationsIself) :: Declarations) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Let _rangeIself _declarationsIself _expressionIself + {-# INLINE rule319 #-} + rule319 = \ _self -> + _self + {-# INLINE rule320 #-} + rule320 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule321 #-} + rule321 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule322 #-} + rule322 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule323 #-} + rule323 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule324 #-} + rule324 = \ ((_declarationsIbindingGroups) :: BindingGroups) -> + _declarationsIbindingGroups + {-# INLINE rule325 #-} + rule325 = \ ((_declarationsIkappaUnique) :: Int) -> + _declarationsIkappaUnique +{-# NOINLINE sem_Expression_Do #-} +sem_Expression_Do :: T_Range -> T_Statements -> T_Expression +sem_Expression_Do arg_range_ arg_statements_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _statementsX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_statements_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Statements_vOut157 _statementsIbindingGroups _statementsIkappaUnique _statementsIself) = inv_Statements_s158 _statementsX158 (T_Statements_vIn157 _statementsObindingGroups _statementsOkappaUnique) + _self = rule326 _rangeIself _statementsIself + _lhsOself :: Expression + _lhsOself = rule327 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule328 _statementsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule329 _statementsIkappaUnique + _statementsObindingGroups = rule330 _lhsIbindingGroups + _statementsOkappaUnique = rule331 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule326 #-} + rule326 = \ ((_rangeIself) :: Range) ((_statementsIself) :: Statements) -> + Expression_Do _rangeIself _statementsIself + {-# INLINE rule327 #-} + rule327 = \ _self -> + _self + {-# INLINE rule328 #-} + rule328 = \ ((_statementsIbindingGroups) :: BindingGroups) -> + _statementsIbindingGroups + {-# INLINE rule329 #-} + rule329 = \ ((_statementsIkappaUnique) :: Int) -> + _statementsIkappaUnique + {-# INLINE rule330 #-} + rule330 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule331 #-} + rule331 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_List #-} +sem_Expression_List :: T_Range -> T_Expressions -> T_Expression +sem_Expression_List arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIbindingGroups _expressionsIkappaUnique _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 _expressionsObindingGroups _expressionsOkappaUnique) + _self = rule332 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule333 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule334 _expressionsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule335 _expressionsIkappaUnique + _expressionsObindingGroups = rule336 _lhsIbindingGroups + _expressionsOkappaUnique = rule337 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule332 #-} + rule332 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_List _rangeIself _expressionsIself + {-# INLINE rule333 #-} + rule333 = \ _self -> + _self + {-# INLINE rule334 #-} + rule334 = \ ((_expressionsIbindingGroups) :: BindingGroups) -> + _expressionsIbindingGroups + {-# INLINE rule335 #-} + rule335 = \ ((_expressionsIkappaUnique) :: Int) -> + _expressionsIkappaUnique + {-# INLINE rule336 #-} + rule336 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule337 #-} + rule337 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_Tuple #-} +sem_Expression_Tuple :: T_Range -> T_Expressions -> T_Expression +sem_Expression_Tuple arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIbindingGroups _expressionsIkappaUnique _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 _expressionsObindingGroups _expressionsOkappaUnique) + _self = rule338 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule339 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule340 _expressionsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule341 _expressionsIkappaUnique + _expressionsObindingGroups = rule342 _lhsIbindingGroups + _expressionsOkappaUnique = rule343 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule338 #-} + rule338 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_Tuple _rangeIself _expressionsIself + {-# INLINE rule339 #-} + rule339 = \ _self -> + _self + {-# INLINE rule340 #-} + rule340 = \ ((_expressionsIbindingGroups) :: BindingGroups) -> + _expressionsIbindingGroups + {-# INLINE rule341 #-} + rule341 = \ ((_expressionsIkappaUnique) :: Int) -> + _expressionsIkappaUnique + {-# INLINE rule342 #-} + rule342 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule343 #-} + rule343 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_Comprehension #-} +sem_Expression_Comprehension :: T_Range -> T_Expression -> T_Qualifiers -> T_Expression +sem_Expression_Comprehension arg_range_ arg_expression_ arg_qualifiers_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _qualifiersX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_qualifiers_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + (T_Qualifiers_vOut130 _qualifiersIbindingGroups _qualifiersIkappaUnique _qualifiersIself) = inv_Qualifiers_s131 _qualifiersX131 (T_Qualifiers_vIn130 _qualifiersObindingGroups _qualifiersOkappaUnique) + _self = rule344 _expressionIself _qualifiersIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule345 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule346 _qualifiersIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule347 _qualifiersIkappaUnique + _expressionObindingGroups = rule348 _lhsIbindingGroups + _expressionOkappaUnique = rule349 _lhsIkappaUnique + _qualifiersObindingGroups = rule350 _expressionIbindingGroups + _qualifiersOkappaUnique = rule351 _expressionIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule344 #-} + rule344 = \ ((_expressionIself) :: Expression) ((_qualifiersIself) :: Qualifiers) ((_rangeIself) :: Range) -> + Expression_Comprehension _rangeIself _expressionIself _qualifiersIself + {-# INLINE rule345 #-} + rule345 = \ _self -> + _self + {-# INLINE rule346 #-} + rule346 = \ ((_qualifiersIbindingGroups) :: BindingGroups) -> + _qualifiersIbindingGroups + {-# INLINE rule347 #-} + rule347 = \ ((_qualifiersIkappaUnique) :: Int) -> + _qualifiersIkappaUnique + {-# INLINE rule348 #-} + rule348 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule349 #-} + rule349 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule350 #-} + rule350 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule351 #-} + rule351 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique +{-# NOINLINE sem_Expression_Typed #-} +sem_Expression_Typed :: T_Range -> T_Expression -> T_Type -> T_Expression +sem_Expression_Typed arg_range_ arg_expression_ arg_type_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + (T_Type_vOut163 _typeIassumptions _typeIconstraints _typeIkappa _typeIkappaUnique _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOconstraints _typeOkappaUnique) + _typeOconstraints = rule352 () + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule353 _expressionIbindingGroups _newGroup + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule354 _tvEnv _typeIkappaUnique + _newConstraint = rule355 _rangeIself _typeIkappa _typeIself + _tvEnv = rule356 _typeIassumptions _typeIkappaUnique + (_cset,_aset) = rule357 _tvEnv _typeIassumptions + _newGroup = rule358 _aset _cset _newConstraint _typeIconstraints + _self = rule359 _expressionIself _rangeIself _typeIself + _lhsOself :: Expression + _lhsOself = rule360 _self + _expressionObindingGroups = rule361 _lhsIbindingGroups + _expressionOkappaUnique = rule362 _lhsIkappaUnique + _typeOkappaUnique = rule363 _expressionIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule352 #-} + rule352 = \ (_ :: ()) -> + [] + {-# INLINE rule353 #-} + rule353 = \ ((_expressionIbindingGroups) :: BindingGroups) _newGroup -> + _newGroup : _expressionIbindingGroups + {-# INLINE rule354 #-} + rule354 = \ _tvEnv ((_typeIkappaUnique) :: Int) -> + _typeIkappaUnique + length _tvEnv + {-# INLINE rule355 #-} + rule355 = \ ((_rangeIself) :: Range) ((_typeIkappa) :: Kind) ((_typeIself) :: Type) -> + (_typeIkappa <==> star) (mustBeStar _rangeIself "type annotation" _typeIself) + {-# INLINE rule356 #-} + rule356 = \ ((_typeIassumptions) :: Assumptions) ((_typeIkappaUnique) :: Int) -> + zip (getTypeVariables _typeIassumptions) (map TVar [_typeIkappaUnique..]) + {-# INLINE rule357 #-} + rule357 = \ _tvEnv ((_typeIassumptions) :: Assumptions) -> + (M.fromList _tvEnv .===. _typeIassumptions) (\n -> unexpected $ "Expression.Typed " ++ show n) + {-# INLINE rule358 #-} + rule358 = \ _aset _cset _newConstraint ((_typeIconstraints) :: KindConstraints) -> + (M.empty, _aset, _cset ++ _typeIconstraints ++ [_newConstraint]) + {-# INLINE rule359 #-} + rule359 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Expression_Typed _rangeIself _expressionIself _typeIself + {-# INLINE rule360 #-} + rule360 = \ _self -> + _self + {-# INLINE rule361 #-} + rule361 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule362 #-} + rule362 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule363 #-} + rule363 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique +{-# NOINLINE sem_Expression_RecordConstruction #-} +sem_Expression_RecordConstruction :: T_Range -> T_Name -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordConstruction arg_range_ arg_name_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIbindingGroups _recordExpressionBindingsIkappaUnique _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 _recordExpressionBindingsObindingGroups _recordExpressionBindingsOkappaUnique) + _self = rule364 _nameIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule365 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule366 _recordExpressionBindingsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule367 _recordExpressionBindingsIkappaUnique + _recordExpressionBindingsObindingGroups = rule368 _lhsIbindingGroups + _recordExpressionBindingsOkappaUnique = rule369 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule364 #-} + rule364 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordConstruction _rangeIself _nameIself _recordExpressionBindingsIself + {-# INLINE rule365 #-} + rule365 = \ _self -> + _self + {-# INLINE rule366 #-} + rule366 = \ ((_recordExpressionBindingsIbindingGroups) :: BindingGroups) -> + _recordExpressionBindingsIbindingGroups + {-# INLINE rule367 #-} + rule367 = \ ((_recordExpressionBindingsIkappaUnique) :: Int) -> + _recordExpressionBindingsIkappaUnique + {-# INLINE rule368 #-} + rule368 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule369 #-} + rule369 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_RecordUpdate #-} +sem_Expression_RecordUpdate :: T_Range -> T_Expression -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordUpdate arg_range_ arg_expression_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIbindingGroups _recordExpressionBindingsIkappaUnique _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 _recordExpressionBindingsObindingGroups _recordExpressionBindingsOkappaUnique) + _self = rule370 _expressionIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule371 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule372 _recordExpressionBindingsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule373 _recordExpressionBindingsIkappaUnique + _expressionObindingGroups = rule374 _lhsIbindingGroups + _expressionOkappaUnique = rule375 _lhsIkappaUnique + _recordExpressionBindingsObindingGroups = rule376 _expressionIbindingGroups + _recordExpressionBindingsOkappaUnique = rule377 _expressionIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule370 #-} + rule370 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordUpdate _rangeIself _expressionIself _recordExpressionBindingsIself + {-# INLINE rule371 #-} + rule371 = \ _self -> + _self + {-# INLINE rule372 #-} + rule372 = \ ((_recordExpressionBindingsIbindingGroups) :: BindingGroups) -> + _recordExpressionBindingsIbindingGroups + {-# INLINE rule373 #-} + rule373 = \ ((_recordExpressionBindingsIkappaUnique) :: Int) -> + _recordExpressionBindingsIkappaUnique + {-# INLINE rule374 #-} + rule374 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule375 #-} + rule375 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule376 #-} + rule376 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule377 #-} + rule377 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique +{-# NOINLINE sem_Expression_Enum #-} +sem_Expression_Enum :: T_Range -> T_Expression -> T_MaybeExpression -> T_MaybeExpression -> T_Expression +sem_Expression_Enum arg_range_ arg_from_ arg_then_ arg_to_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fromX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_from_)) + _thenX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_then_)) + _toX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_to_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _fromIbindingGroups _fromIkappaUnique _fromIself) = inv_Expression_s41 _fromX41 (T_Expression_vIn40 _fromObindingGroups _fromOkappaUnique) + (T_MaybeExpression_vOut94 _thenIbindingGroups _thenIkappaUnique _thenIself) = inv_MaybeExpression_s95 _thenX95 (T_MaybeExpression_vIn94 _thenObindingGroups _thenOkappaUnique) + (T_MaybeExpression_vOut94 _toIbindingGroups _toIkappaUnique _toIself) = inv_MaybeExpression_s95 _toX95 (T_MaybeExpression_vIn94 _toObindingGroups _toOkappaUnique) + _self = rule378 _fromIself _rangeIself _thenIself _toIself + _lhsOself :: Expression + _lhsOself = rule379 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule380 _toIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule381 _toIkappaUnique + _fromObindingGroups = rule382 _lhsIbindingGroups + _fromOkappaUnique = rule383 _lhsIkappaUnique + _thenObindingGroups = rule384 _fromIbindingGroups + _thenOkappaUnique = rule385 _fromIkappaUnique + _toObindingGroups = rule386 _thenIbindingGroups + _toOkappaUnique = rule387 _thenIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule378 #-} + rule378 = \ ((_fromIself) :: Expression) ((_rangeIself) :: Range) ((_thenIself) :: MaybeExpression) ((_toIself) :: MaybeExpression) -> + Expression_Enum _rangeIself _fromIself _thenIself _toIself + {-# INLINE rule379 #-} + rule379 = \ _self -> + _self + {-# INLINE rule380 #-} + rule380 = \ ((_toIbindingGroups) :: BindingGroups) -> + _toIbindingGroups + {-# INLINE rule381 #-} + rule381 = \ ((_toIkappaUnique) :: Int) -> + _toIkappaUnique + {-# INLINE rule382 #-} + rule382 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule383 #-} + rule383 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule384 #-} + rule384 = \ ((_fromIbindingGroups) :: BindingGroups) -> + _fromIbindingGroups + {-# INLINE rule385 #-} + rule385 = \ ((_fromIkappaUnique) :: Int) -> + _fromIkappaUnique + {-# INLINE rule386 #-} + rule386 = \ ((_thenIbindingGroups) :: BindingGroups) -> + _thenIbindingGroups + {-# INLINE rule387 #-} + rule387 = \ ((_thenIkappaUnique) :: Int) -> + _thenIkappaUnique +{-# NOINLINE sem_Expression_Negate #-} +sem_Expression_Negate :: T_Range -> T_Expression -> T_Expression +sem_Expression_Negate arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule388 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule389 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule390 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule391 _expressionIkappaUnique + _expressionObindingGroups = rule392 _lhsIbindingGroups + _expressionOkappaUnique = rule393 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule388 #-} + rule388 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Negate _rangeIself _expressionIself + {-# INLINE rule389 #-} + rule389 = \ _self -> + _self + {-# INLINE rule390 #-} + rule390 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule391 #-} + rule391 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule392 #-} + rule392 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule393 #-} + rule393 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Expression_NegateFloat #-} +sem_Expression_NegateFloat :: T_Range -> T_Expression -> T_Expression +sem_Expression_NegateFloat arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule394 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule395 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule396 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule397 _expressionIkappaUnique + _expressionObindingGroups = rule398 _lhsIbindingGroups + _expressionOkappaUnique = rule399 _lhsIkappaUnique + __result_ = T_Expression_vOut40 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule394 #-} + rule394 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NegateFloat _rangeIself _expressionIself + {-# INLINE rule395 #-} + rule395 = \ _self -> + _self + {-# INLINE rule396 #-} + rule396 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule397 #-} + rule397 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule398 #-} + rule398 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule399 #-} + rule399 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Expressions ------------------------------------------------- +-- wrapper +data Inh_Expressions = Inh_Expressions { bindingGroups_Inh_Expressions :: (BindingGroups), kappaUnique_Inh_Expressions :: (Int) } +data Syn_Expressions = Syn_Expressions { bindingGroups_Syn_Expressions :: (BindingGroups), kappaUnique_Syn_Expressions :: (Int), self_Syn_Expressions :: (Expressions) } +{-# INLINABLE wrap_Expressions #-} +wrap_Expressions :: T_Expressions -> Inh_Expressions -> (Syn_Expressions ) +wrap_Expressions (T_Expressions act) (Inh_Expressions _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expressions_vIn43 _lhsIbindingGroups _lhsIkappaUnique + (T_Expressions_vOut43 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_Expressions_s44 sem arg) + return (Syn_Expressions _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expressions #-} +sem_Expressions :: Expressions -> T_Expressions +sem_Expressions list = Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list) + +-- semantic domain +newtype T_Expressions = T_Expressions { + attach_T_Expressions :: Identity (T_Expressions_s44 ) + } +newtype T_Expressions_s44 = C_Expressions_s44 { + inv_Expressions_s44 :: (T_Expressions_v43 ) + } +data T_Expressions_s45 = C_Expressions_s45 +type T_Expressions_v43 = (T_Expressions_vIn43 ) -> (T_Expressions_vOut43 ) +data T_Expressions_vIn43 = T_Expressions_vIn43 (BindingGroups) (Int) +data T_Expressions_vOut43 = T_Expressions_vOut43 (BindingGroups) (Int) (Expressions) +{-# NOINLINE sem_Expressions_Cons #-} +sem_Expressions_Cons :: T_Expression -> T_Expressions -> T_Expressions +sem_Expressions_Cons arg_hd_ arg_tl_ = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_hd_)) + _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_tl_)) + (T_Expression_vOut40 _hdIbindingGroups _hdIkappaUnique _hdIself) = inv_Expression_s41 _hdX41 (T_Expression_vIn40 _hdObindingGroups _hdOkappaUnique) + (T_Expressions_vOut43 _tlIbindingGroups _tlIkappaUnique _tlIself) = inv_Expressions_s44 _tlX44 (T_Expressions_vIn43 _tlObindingGroups _tlOkappaUnique) + _self = rule400 _hdIself _tlIself + _lhsOself :: Expressions + _lhsOself = rule401 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule402 _tlIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule403 _tlIkappaUnique + _hdObindingGroups = rule404 _lhsIbindingGroups + _hdOkappaUnique = rule405 _lhsIkappaUnique + _tlObindingGroups = rule406 _hdIbindingGroups + _tlOkappaUnique = rule407 _hdIkappaUnique + __result_ = T_Expressions_vOut43 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule400 #-} + rule400 = \ ((_hdIself) :: Expression) ((_tlIself) :: Expressions) -> + (:) _hdIself _tlIself + {-# INLINE rule401 #-} + rule401 = \ _self -> + _self + {-# INLINE rule402 #-} + rule402 = \ ((_tlIbindingGroups) :: BindingGroups) -> + _tlIbindingGroups + {-# INLINE rule403 #-} + rule403 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule404 #-} + rule404 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule405 #-} + rule405 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule406 #-} + rule406 = \ ((_hdIbindingGroups) :: BindingGroups) -> + _hdIbindingGroups + {-# INLINE rule407 #-} + rule407 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_Expressions_Nil #-} +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _self = rule408 () + _lhsOself :: Expressions + _lhsOself = rule409 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule410 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule411 _lhsIkappaUnique + __result_ = T_Expressions_vOut43 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule408 #-} + rule408 = \ (_ :: ()) -> + [] + {-# INLINE rule409 #-} + rule409 = \ _self -> + _self + {-# INLINE rule410 #-} + rule410 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule411 #-} + rule411 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- FieldDeclaration -------------------------------------------- +-- wrapper +data Inh_FieldDeclaration = Inh_FieldDeclaration { kappaUnique_Inh_FieldDeclaration :: (Int) } +data Syn_FieldDeclaration = Syn_FieldDeclaration { kappaUnique_Syn_FieldDeclaration :: (Int), self_Syn_FieldDeclaration :: (FieldDeclaration) } +{-# INLINABLE wrap_FieldDeclaration #-} +wrap_FieldDeclaration :: T_FieldDeclaration -> Inh_FieldDeclaration -> (Syn_FieldDeclaration ) +wrap_FieldDeclaration (T_FieldDeclaration act) (Inh_FieldDeclaration _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclaration_vIn46 _lhsIkappaUnique + (T_FieldDeclaration_vOut46 _lhsOkappaUnique _lhsOself) <- return (inv_FieldDeclaration_s47 sem arg) + return (Syn_FieldDeclaration _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# INLINE sem_FieldDeclaration #-} +sem_FieldDeclaration :: FieldDeclaration -> T_FieldDeclaration +sem_FieldDeclaration ( FieldDeclaration_FieldDeclaration range_ names_ type_ ) = sem_FieldDeclaration_FieldDeclaration ( sem_Range range_ ) ( sem_Names names_ ) ( sem_AnnotatedType type_ ) + +-- semantic domain +newtype T_FieldDeclaration = T_FieldDeclaration { + attach_T_FieldDeclaration :: Identity (T_FieldDeclaration_s47 ) + } +newtype T_FieldDeclaration_s47 = C_FieldDeclaration_s47 { + inv_FieldDeclaration_s47 :: (T_FieldDeclaration_v46 ) + } +data T_FieldDeclaration_s48 = C_FieldDeclaration_s48 +type T_FieldDeclaration_v46 = (T_FieldDeclaration_vIn46 ) -> (T_FieldDeclaration_vOut46 ) +data T_FieldDeclaration_vIn46 = T_FieldDeclaration_vIn46 (Int) +data T_FieldDeclaration_vOut46 = T_FieldDeclaration_vOut46 (Int) (FieldDeclaration) +{-# NOINLINE sem_FieldDeclaration_FieldDeclaration #-} +sem_FieldDeclaration_FieldDeclaration :: T_Range -> T_Names -> T_AnnotatedType -> T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration arg_range_ arg_names_ arg_type_ = T_FieldDeclaration (return st47) where + {-# NOINLINE st47 #-} + st47 = let + v46 :: T_FieldDeclaration_v46 + v46 = \ (T_FieldDeclaration_vIn46 _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_AnnotatedType_vOut7 _typeIassumptions _typeIconstraints _typeIkappa _typeIkappaUnique _typeIself) = inv_AnnotatedType_s8 _typeX8 (T_AnnotatedType_vIn7 _typeOconstraints _typeOkappaUnique) + _constraints = rule412 () + _self = rule413 _namesIself _rangeIself _typeIself + _lhsOself :: FieldDeclaration + _lhsOself = rule414 _self + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule415 _typeIkappaUnique + _typeOconstraints = rule416 _constraints + _typeOkappaUnique = rule417 _lhsIkappaUnique + __result_ = T_FieldDeclaration_vOut46 _lhsOkappaUnique _lhsOself + in __result_ ) + in C_FieldDeclaration_s47 v46 + {-# INLINE rule412 #-} + rule412 = \ (_ :: ()) -> + internalError "KindInferencing.ag" "n/a" "Field decls are not supported" + {-# INLINE rule413 #-} + rule413 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: AnnotatedType) -> + FieldDeclaration_FieldDeclaration _rangeIself _namesIself _typeIself + {-# INLINE rule414 #-} + rule414 = \ _self -> + _self + {-# INLINE rule415 #-} + rule415 = \ ((_typeIkappaUnique) :: Int) -> + _typeIkappaUnique + {-# INLINE rule416 #-} + rule416 = \ _constraints -> + _constraints + {-# INLINE rule417 #-} + rule417 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- FieldDeclarations ------------------------------------------- +-- wrapper +data Inh_FieldDeclarations = Inh_FieldDeclarations { kappaUnique_Inh_FieldDeclarations :: (Int) } +data Syn_FieldDeclarations = Syn_FieldDeclarations { kappaUnique_Syn_FieldDeclarations :: (Int), self_Syn_FieldDeclarations :: (FieldDeclarations) } +{-# INLINABLE wrap_FieldDeclarations #-} +wrap_FieldDeclarations :: T_FieldDeclarations -> Inh_FieldDeclarations -> (Syn_FieldDeclarations ) +wrap_FieldDeclarations (T_FieldDeclarations act) (Inh_FieldDeclarations _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclarations_vIn49 _lhsIkappaUnique + (T_FieldDeclarations_vOut49 _lhsOkappaUnique _lhsOself) <- return (inv_FieldDeclarations_s50 sem arg) + return (Syn_FieldDeclarations _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FieldDeclarations #-} +sem_FieldDeclarations :: FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations list = Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list) + +-- semantic domain +newtype T_FieldDeclarations = T_FieldDeclarations { + attach_T_FieldDeclarations :: Identity (T_FieldDeclarations_s50 ) + } +newtype T_FieldDeclarations_s50 = C_FieldDeclarations_s50 { + inv_FieldDeclarations_s50 :: (T_FieldDeclarations_v49 ) + } +data T_FieldDeclarations_s51 = C_FieldDeclarations_s51 +type T_FieldDeclarations_v49 = (T_FieldDeclarations_vIn49 ) -> (T_FieldDeclarations_vOut49 ) +data T_FieldDeclarations_vIn49 = T_FieldDeclarations_vIn49 (Int) +data T_FieldDeclarations_vOut49 = T_FieldDeclarations_vOut49 (Int) (FieldDeclarations) +{-# NOINLINE sem_FieldDeclarations_Cons #-} +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> T_FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations_Cons arg_hd_ arg_tl_ = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 _lhsIkappaUnique) -> ( let + _hdX47 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclaration (arg_hd_)) + _tlX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_tl_)) + (T_FieldDeclaration_vOut46 _hdIkappaUnique _hdIself) = inv_FieldDeclaration_s47 _hdX47 (T_FieldDeclaration_vIn46 _hdOkappaUnique) + (T_FieldDeclarations_vOut49 _tlIkappaUnique _tlIself) = inv_FieldDeclarations_s50 _tlX50 (T_FieldDeclarations_vIn49 _tlOkappaUnique) + _self = rule418 _hdIself _tlIself + _lhsOself :: FieldDeclarations + _lhsOself = rule419 _self + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule420 _tlIkappaUnique + _hdOkappaUnique = rule421 _lhsIkappaUnique + _tlOkappaUnique = rule422 _hdIkappaUnique + __result_ = T_FieldDeclarations_vOut49 _lhsOkappaUnique _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule418 #-} + rule418 = \ ((_hdIself) :: FieldDeclaration) ((_tlIself) :: FieldDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule419 #-} + rule419 = \ _self -> + _self + {-# INLINE rule420 #-} + rule420 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule421 #-} + rule421 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule422 #-} + rule422 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_FieldDeclarations_Nil #-} +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 _lhsIkappaUnique) -> ( let + _self = rule423 () + _lhsOself :: FieldDeclarations + _lhsOself = rule424 _self + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule425 _lhsIkappaUnique + __result_ = T_FieldDeclarations_vOut49 _lhsOkappaUnique _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule423 #-} + rule423 = \ (_ :: ()) -> + [] + {-# INLINE rule424 #-} + rule424 = \ _self -> + _self + {-# INLINE rule425 #-} + rule425 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Fixity ------------------------------------------------------ +-- wrapper +data Inh_Fixity = Inh_Fixity { } +data Syn_Fixity = Syn_Fixity { self_Syn_Fixity :: (Fixity) } +{-# INLINABLE wrap_Fixity #-} +wrap_Fixity :: T_Fixity -> Inh_Fixity -> (Syn_Fixity ) +wrap_Fixity (T_Fixity act) (Inh_Fixity ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Fixity_vIn52 + (T_Fixity_vOut52 _lhsOself) <- return (inv_Fixity_s53 sem arg) + return (Syn_Fixity _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Fixity #-} +sem_Fixity :: Fixity -> T_Fixity +sem_Fixity ( Fixity_Infixl range_ ) = sem_Fixity_Infixl ( sem_Range range_ ) +sem_Fixity ( Fixity_Infixr range_ ) = sem_Fixity_Infixr ( sem_Range range_ ) +sem_Fixity ( Fixity_Infix range_ ) = sem_Fixity_Infix ( sem_Range range_ ) + +-- semantic domain +newtype T_Fixity = T_Fixity { + attach_T_Fixity :: Identity (T_Fixity_s53 ) + } +newtype T_Fixity_s53 = C_Fixity_s53 { + inv_Fixity_s53 :: (T_Fixity_v52 ) + } +data T_Fixity_s54 = C_Fixity_s54 +type T_Fixity_v52 = (T_Fixity_vIn52 ) -> (T_Fixity_vOut52 ) +data T_Fixity_vIn52 = T_Fixity_vIn52 +data T_Fixity_vOut52 = T_Fixity_vOut52 (Fixity) +{-# NOINLINE sem_Fixity_Infixl #-} +sem_Fixity_Infixl :: T_Range -> T_Fixity +sem_Fixity_Infixl arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule426 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule427 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule426 #-} + rule426 = \ ((_rangeIself) :: Range) -> + Fixity_Infixl _rangeIself + {-# INLINE rule427 #-} + rule427 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infixr #-} +sem_Fixity_Infixr :: T_Range -> T_Fixity +sem_Fixity_Infixr arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule428 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule429 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule428 #-} + rule428 = \ ((_rangeIself) :: Range) -> + Fixity_Infixr _rangeIself + {-# INLINE rule429 #-} + rule429 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infix #-} +sem_Fixity_Infix :: T_Range -> T_Fixity +sem_Fixity_Infix arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule430 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule431 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule430 #-} + rule430 = \ ((_rangeIself) :: Range) -> + Fixity_Infix _rangeIself + {-# INLINE rule431 #-} + rule431 = \ _self -> + _self + +-- FunctionBinding --------------------------------------------- +-- wrapper +data Inh_FunctionBinding = Inh_FunctionBinding { bindingGroups_Inh_FunctionBinding :: (BindingGroups), kappaUnique_Inh_FunctionBinding :: (Int) } +data Syn_FunctionBinding = Syn_FunctionBinding { bindingGroups_Syn_FunctionBinding :: (BindingGroups), kappaUnique_Syn_FunctionBinding :: (Int), self_Syn_FunctionBinding :: (FunctionBinding) } +{-# INLINABLE wrap_FunctionBinding #-} +wrap_FunctionBinding :: T_FunctionBinding -> Inh_FunctionBinding -> (Syn_FunctionBinding ) +wrap_FunctionBinding (T_FunctionBinding act) (Inh_FunctionBinding _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBinding_vIn55 _lhsIbindingGroups _lhsIkappaUnique + (T_FunctionBinding_vOut55 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_FunctionBinding_s56 sem arg) + return (Syn_FunctionBinding _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBinding #-} +sem_FunctionBinding :: FunctionBinding -> T_FunctionBinding +sem_FunctionBinding ( FunctionBinding_Hole range_ id_ ) = sem_FunctionBinding_Hole ( sem_Range range_ ) id_ +sem_FunctionBinding ( FunctionBinding_Feedback range_ feedback_ functionBinding_ ) = sem_FunctionBinding_Feedback ( sem_Range range_ ) feedback_ ( sem_FunctionBinding functionBinding_ ) +sem_FunctionBinding ( FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ ) = sem_FunctionBinding_FunctionBinding ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_RightHandSide righthandside_ ) + +-- semantic domain +newtype T_FunctionBinding = T_FunctionBinding { + attach_T_FunctionBinding :: Identity (T_FunctionBinding_s56 ) + } +newtype T_FunctionBinding_s56 = C_FunctionBinding_s56 { + inv_FunctionBinding_s56 :: (T_FunctionBinding_v55 ) + } +data T_FunctionBinding_s57 = C_FunctionBinding_s57 +type T_FunctionBinding_v55 = (T_FunctionBinding_vIn55 ) -> (T_FunctionBinding_vOut55 ) +data T_FunctionBinding_vIn55 = T_FunctionBinding_vIn55 (BindingGroups) (Int) +data T_FunctionBinding_vOut55 = T_FunctionBinding_vOut55 (BindingGroups) (Int) (FunctionBinding) +{-# NOINLINE sem_FunctionBinding_Hole #-} +sem_FunctionBinding_Hole :: T_Range -> (Integer) -> T_FunctionBinding +sem_FunctionBinding_Hole arg_range_ arg_id_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule432 _rangeIself arg_id_ + _lhsOself :: FunctionBinding + _lhsOself = rule433 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule434 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule435 _lhsIkappaUnique + __result_ = T_FunctionBinding_vOut55 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule432 #-} + rule432 = \ ((_rangeIself) :: Range) id_ -> + FunctionBinding_Hole _rangeIself id_ + {-# INLINE rule433 #-} + rule433 = \ _self -> + _self + {-# INLINE rule434 #-} + rule434 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule435 #-} + rule435 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_FunctionBinding_Feedback #-} +sem_FunctionBinding_Feedback :: T_Range -> (String) -> T_FunctionBinding -> T_FunctionBinding +sem_FunctionBinding_Feedback arg_range_ arg_feedback_ arg_functionBinding_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionBindingX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_functionBinding_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBinding_vOut55 _functionBindingIbindingGroups _functionBindingIkappaUnique _functionBindingIself) = inv_FunctionBinding_s56 _functionBindingX56 (T_FunctionBinding_vIn55 _functionBindingObindingGroups _functionBindingOkappaUnique) + _self = rule436 _functionBindingIself _rangeIself arg_feedback_ + _lhsOself :: FunctionBinding + _lhsOself = rule437 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule438 _functionBindingIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule439 _functionBindingIkappaUnique + _functionBindingObindingGroups = rule440 _lhsIbindingGroups + _functionBindingOkappaUnique = rule441 _lhsIkappaUnique + __result_ = T_FunctionBinding_vOut55 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule436 #-} + rule436 = \ ((_functionBindingIself) :: FunctionBinding) ((_rangeIself) :: Range) feedback_ -> + FunctionBinding_Feedback _rangeIself feedback_ _functionBindingIself + {-# INLINE rule437 #-} + rule437 = \ _self -> + _self + {-# INLINE rule438 #-} + rule438 = \ ((_functionBindingIbindingGroups) :: BindingGroups) -> + _functionBindingIbindingGroups + {-# INLINE rule439 #-} + rule439 = \ ((_functionBindingIkappaUnique) :: Int) -> + _functionBindingIkappaUnique + {-# INLINE rule440 #-} + rule440 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule441 #-} + rule441 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_FunctionBinding_FunctionBinding #-} +sem_FunctionBinding_FunctionBinding :: T_Range -> T_LeftHandSide -> T_RightHandSide -> T_FunctionBinding +sem_FunctionBinding_FunctionBinding arg_range_ arg_lefthandside_ arg_righthandside_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIself) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 ) + (T_RightHandSide_vOut148 _righthandsideIbindingGroups _righthandsideIkappaUnique _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideObindingGroups _righthandsideOkappaUnique) + _self = rule442 _lefthandsideIself _rangeIself _righthandsideIself + _lhsOself :: FunctionBinding + _lhsOself = rule443 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule444 _righthandsideIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule445 _righthandsideIkappaUnique + _righthandsideObindingGroups = rule446 _lhsIbindingGroups + _righthandsideOkappaUnique = rule447 _lhsIkappaUnique + __result_ = T_FunctionBinding_vOut55 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule442 #-} + rule442 = \ ((_lefthandsideIself) :: LeftHandSide) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + FunctionBinding_FunctionBinding _rangeIself _lefthandsideIself _righthandsideIself + {-# INLINE rule443 #-} + rule443 = \ _self -> + _self + {-# INLINE rule444 #-} + rule444 = \ ((_righthandsideIbindingGroups) :: BindingGroups) -> + _righthandsideIbindingGroups + {-# INLINE rule445 #-} + rule445 = \ ((_righthandsideIkappaUnique) :: Int) -> + _righthandsideIkappaUnique + {-# INLINE rule446 #-} + rule446 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule447 #-} + rule447 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- FunctionBindings -------------------------------------------- +-- wrapper +data Inh_FunctionBindings = Inh_FunctionBindings { bindingGroups_Inh_FunctionBindings :: (BindingGroups), kappaUnique_Inh_FunctionBindings :: (Int) } +data Syn_FunctionBindings = Syn_FunctionBindings { bindingGroups_Syn_FunctionBindings :: (BindingGroups), kappaUnique_Syn_FunctionBindings :: (Int), self_Syn_FunctionBindings :: (FunctionBindings) } +{-# INLINABLE wrap_FunctionBindings #-} +wrap_FunctionBindings :: T_FunctionBindings -> Inh_FunctionBindings -> (Syn_FunctionBindings ) +wrap_FunctionBindings (T_FunctionBindings act) (Inh_FunctionBindings _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBindings_vIn58 _lhsIbindingGroups _lhsIkappaUnique + (T_FunctionBindings_vOut58 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_FunctionBindings_s59 sem arg) + return (Syn_FunctionBindings _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBindings #-} +sem_FunctionBindings :: FunctionBindings -> T_FunctionBindings +sem_FunctionBindings list = Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list) + +-- semantic domain +newtype T_FunctionBindings = T_FunctionBindings { + attach_T_FunctionBindings :: Identity (T_FunctionBindings_s59 ) + } +newtype T_FunctionBindings_s59 = C_FunctionBindings_s59 { + inv_FunctionBindings_s59 :: (T_FunctionBindings_v58 ) + } +data T_FunctionBindings_s60 = C_FunctionBindings_s60 +type T_FunctionBindings_v58 = (T_FunctionBindings_vIn58 ) -> (T_FunctionBindings_vOut58 ) +data T_FunctionBindings_vIn58 = T_FunctionBindings_vIn58 (BindingGroups) (Int) +data T_FunctionBindings_vOut58 = T_FunctionBindings_vOut58 (BindingGroups) (Int) (FunctionBindings) +{-# NOINLINE sem_FunctionBindings_Cons #-} +sem_FunctionBindings_Cons :: T_FunctionBinding -> T_FunctionBindings -> T_FunctionBindings +sem_FunctionBindings_Cons arg_hd_ arg_tl_ = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _hdX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_hd_)) + _tlX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_tl_)) + (T_FunctionBinding_vOut55 _hdIbindingGroups _hdIkappaUnique _hdIself) = inv_FunctionBinding_s56 _hdX56 (T_FunctionBinding_vIn55 _hdObindingGroups _hdOkappaUnique) + (T_FunctionBindings_vOut58 _tlIbindingGroups _tlIkappaUnique _tlIself) = inv_FunctionBindings_s59 _tlX59 (T_FunctionBindings_vIn58 _tlObindingGroups _tlOkappaUnique) + _self = rule448 _hdIself _tlIself + _lhsOself :: FunctionBindings + _lhsOself = rule449 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule450 _tlIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule451 _tlIkappaUnique + _hdObindingGroups = rule452 _lhsIbindingGroups + _hdOkappaUnique = rule453 _lhsIkappaUnique + _tlObindingGroups = rule454 _hdIbindingGroups + _tlOkappaUnique = rule455 _hdIkappaUnique + __result_ = T_FunctionBindings_vOut58 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule448 #-} + rule448 = \ ((_hdIself) :: FunctionBinding) ((_tlIself) :: FunctionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule449 #-} + rule449 = \ _self -> + _self + {-# INLINE rule450 #-} + rule450 = \ ((_tlIbindingGroups) :: BindingGroups) -> + _tlIbindingGroups + {-# INLINE rule451 #-} + rule451 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule452 #-} + rule452 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule453 #-} + rule453 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule454 #-} + rule454 = \ ((_hdIbindingGroups) :: BindingGroups) -> + _hdIbindingGroups + {-# INLINE rule455 #-} + rule455 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_FunctionBindings_Nil #-} +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _self = rule456 () + _lhsOself :: FunctionBindings + _lhsOself = rule457 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule458 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule459 _lhsIkappaUnique + __result_ = T_FunctionBindings_vOut58 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule456 #-} + rule456 = \ (_ :: ()) -> + [] + {-# INLINE rule457 #-} + rule457 = \ _self -> + _self + {-# INLINE rule458 #-} + rule458 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule459 #-} + rule459 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- GuardedExpression ------------------------------------------- +-- wrapper +data Inh_GuardedExpression = Inh_GuardedExpression { bindingGroups_Inh_GuardedExpression :: (BindingGroups), kappaUnique_Inh_GuardedExpression :: (Int) } +data Syn_GuardedExpression = Syn_GuardedExpression { bindingGroups_Syn_GuardedExpression :: (BindingGroups), kappaUnique_Syn_GuardedExpression :: (Int), self_Syn_GuardedExpression :: (GuardedExpression) } +{-# INLINABLE wrap_GuardedExpression #-} +wrap_GuardedExpression :: T_GuardedExpression -> Inh_GuardedExpression -> (Syn_GuardedExpression ) +wrap_GuardedExpression (T_GuardedExpression act) (Inh_GuardedExpression _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpression_vIn61 _lhsIbindingGroups _lhsIkappaUnique + (T_GuardedExpression_vOut61 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_GuardedExpression_s62 sem arg) + return (Syn_GuardedExpression _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpression #-} +sem_GuardedExpression :: GuardedExpression -> T_GuardedExpression +sem_GuardedExpression ( GuardedExpression_GuardedExpression range_ guard_ expression_ ) = sem_GuardedExpression_GuardedExpression ( sem_Range range_ ) ( sem_Expression guard_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_GuardedExpression = T_GuardedExpression { + attach_T_GuardedExpression :: Identity (T_GuardedExpression_s62 ) + } +newtype T_GuardedExpression_s62 = C_GuardedExpression_s62 { + inv_GuardedExpression_s62 :: (T_GuardedExpression_v61 ) + } +data T_GuardedExpression_s63 = C_GuardedExpression_s63 +type T_GuardedExpression_v61 = (T_GuardedExpression_vIn61 ) -> (T_GuardedExpression_vOut61 ) +data T_GuardedExpression_vIn61 = T_GuardedExpression_vIn61 (BindingGroups) (Int) +data T_GuardedExpression_vOut61 = T_GuardedExpression_vOut61 (BindingGroups) (Int) (GuardedExpression) +{-# NOINLINE sem_GuardedExpression_GuardedExpression #-} +sem_GuardedExpression_GuardedExpression :: T_Range -> T_Expression -> T_Expression -> T_GuardedExpression +sem_GuardedExpression_GuardedExpression arg_range_ arg_guard_ arg_expression_ = T_GuardedExpression (return st62) where + {-# NOINLINE st62 #-} + st62 = let + v61 :: T_GuardedExpression_v61 + v61 = \ (T_GuardedExpression_vIn61 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIbindingGroups _guardIkappaUnique _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 _guardObindingGroups _guardOkappaUnique) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule460 _expressionIself _guardIself _rangeIself + _lhsOself :: GuardedExpression + _lhsOself = rule461 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule462 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule463 _expressionIkappaUnique + _guardObindingGroups = rule464 _lhsIbindingGroups + _guardOkappaUnique = rule465 _lhsIkappaUnique + _expressionObindingGroups = rule466 _guardIbindingGroups + _expressionOkappaUnique = rule467 _guardIkappaUnique + __result_ = T_GuardedExpression_vOut61 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_GuardedExpression_s62 v61 + {-# INLINE rule460 #-} + rule460 = \ ((_expressionIself) :: Expression) ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + GuardedExpression_GuardedExpression _rangeIself _guardIself _expressionIself + {-# INLINE rule461 #-} + rule461 = \ _self -> + _self + {-# INLINE rule462 #-} + rule462 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule463 #-} + rule463 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule464 #-} + rule464 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule465 #-} + rule465 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule466 #-} + rule466 = \ ((_guardIbindingGroups) :: BindingGroups) -> + _guardIbindingGroups + {-# INLINE rule467 #-} + rule467 = \ ((_guardIkappaUnique) :: Int) -> + _guardIkappaUnique + +-- GuardedExpressions ------------------------------------------ +-- wrapper +data Inh_GuardedExpressions = Inh_GuardedExpressions { bindingGroups_Inh_GuardedExpressions :: (BindingGroups), kappaUnique_Inh_GuardedExpressions :: (Int) } +data Syn_GuardedExpressions = Syn_GuardedExpressions { bindingGroups_Syn_GuardedExpressions :: (BindingGroups), kappaUnique_Syn_GuardedExpressions :: (Int), self_Syn_GuardedExpressions :: (GuardedExpressions) } +{-# INLINABLE wrap_GuardedExpressions #-} +wrap_GuardedExpressions :: T_GuardedExpressions -> Inh_GuardedExpressions -> (Syn_GuardedExpressions ) +wrap_GuardedExpressions (T_GuardedExpressions act) (Inh_GuardedExpressions _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpressions_vIn64 _lhsIbindingGroups _lhsIkappaUnique + (T_GuardedExpressions_vOut64 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_GuardedExpressions_s65 sem arg) + return (Syn_GuardedExpressions _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpressions #-} +sem_GuardedExpressions :: GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions list = Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list) + +-- semantic domain +newtype T_GuardedExpressions = T_GuardedExpressions { + attach_T_GuardedExpressions :: Identity (T_GuardedExpressions_s65 ) + } +newtype T_GuardedExpressions_s65 = C_GuardedExpressions_s65 { + inv_GuardedExpressions_s65 :: (T_GuardedExpressions_v64 ) + } +data T_GuardedExpressions_s66 = C_GuardedExpressions_s66 +type T_GuardedExpressions_v64 = (T_GuardedExpressions_vIn64 ) -> (T_GuardedExpressions_vOut64 ) +data T_GuardedExpressions_vIn64 = T_GuardedExpressions_vIn64 (BindingGroups) (Int) +data T_GuardedExpressions_vOut64 = T_GuardedExpressions_vOut64 (BindingGroups) (Int) (GuardedExpressions) +{-# NOINLINE sem_GuardedExpressions_Cons #-} +sem_GuardedExpressions_Cons :: T_GuardedExpression -> T_GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions_Cons arg_hd_ arg_tl_ = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _hdX62 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpression (arg_hd_)) + _tlX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_tl_)) + (T_GuardedExpression_vOut61 _hdIbindingGroups _hdIkappaUnique _hdIself) = inv_GuardedExpression_s62 _hdX62 (T_GuardedExpression_vIn61 _hdObindingGroups _hdOkappaUnique) + (T_GuardedExpressions_vOut64 _tlIbindingGroups _tlIkappaUnique _tlIself) = inv_GuardedExpressions_s65 _tlX65 (T_GuardedExpressions_vIn64 _tlObindingGroups _tlOkappaUnique) + _self = rule468 _hdIself _tlIself + _lhsOself :: GuardedExpressions + _lhsOself = rule469 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule470 _tlIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule471 _tlIkappaUnique + _hdObindingGroups = rule472 _lhsIbindingGroups + _hdOkappaUnique = rule473 _lhsIkappaUnique + _tlObindingGroups = rule474 _hdIbindingGroups + _tlOkappaUnique = rule475 _hdIkappaUnique + __result_ = T_GuardedExpressions_vOut64 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule468 #-} + rule468 = \ ((_hdIself) :: GuardedExpression) ((_tlIself) :: GuardedExpressions) -> + (:) _hdIself _tlIself + {-# INLINE rule469 #-} + rule469 = \ _self -> + _self + {-# INLINE rule470 #-} + rule470 = \ ((_tlIbindingGroups) :: BindingGroups) -> + _tlIbindingGroups + {-# INLINE rule471 #-} + rule471 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule472 #-} + rule472 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule473 #-} + rule473 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule474 #-} + rule474 = \ ((_hdIbindingGroups) :: BindingGroups) -> + _hdIbindingGroups + {-# INLINE rule475 #-} + rule475 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_GuardedExpressions_Nil #-} +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _self = rule476 () + _lhsOself :: GuardedExpressions + _lhsOself = rule477 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule478 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule479 _lhsIkappaUnique + __result_ = T_GuardedExpressions_vOut64 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule476 #-} + rule476 = \ (_ :: ()) -> + [] + {-# INLINE rule477 #-} + rule477 = \ _self -> + _self + {-# INLINE rule478 #-} + rule478 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule479 #-} + rule479 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Import ------------------------------------------------------ +-- wrapper +data Inh_Import = Inh_Import { } +data Syn_Import = Syn_Import { self_Syn_Import :: (Import) } +{-# INLINABLE wrap_Import #-} +wrap_Import :: T_Import -> Inh_Import -> (Syn_Import ) +wrap_Import (T_Import act) (Inh_Import ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Import_vIn67 + (T_Import_vOut67 _lhsOself) <- return (inv_Import_s68 sem arg) + return (Syn_Import _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Import #-} +sem_Import :: Import -> T_Import +sem_Import ( Import_Variable range_ name_ ) = sem_Import_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Import ( Import_TypeOrClass range_ name_ names_ ) = sem_Import_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Import ( Import_TypeOrClassComplete range_ name_ ) = sem_Import_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Import = T_Import { + attach_T_Import :: Identity (T_Import_s68 ) + } +newtype T_Import_s68 = C_Import_s68 { + inv_Import_s68 :: (T_Import_v67 ) + } +data T_Import_s69 = C_Import_s69 +type T_Import_v67 = (T_Import_vIn67 ) -> (T_Import_vOut67 ) +data T_Import_vIn67 = T_Import_vIn67 +data T_Import_vOut67 = T_Import_vOut67 (Import) +{-# NOINLINE sem_Import_Variable #-} +sem_Import_Variable :: T_Range -> T_Name -> T_Import +sem_Import_Variable arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule480 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule481 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule480 #-} + rule480 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_Variable _rangeIself _nameIself + {-# INLINE rule481 #-} + rule481 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClass #-} +sem_Import_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Import +sem_Import_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _self = rule482 _nameIself _namesIself _rangeIself + _lhsOself :: Import + _lhsOself = rule483 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule482 #-} + rule482 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Import_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule483 #-} + rule483 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClassComplete #-} +sem_Import_TypeOrClassComplete :: T_Range -> T_Name -> T_Import +sem_Import_TypeOrClassComplete arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule484 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule485 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule484 #-} + rule484 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule485 #-} + rule485 = \ _self -> + _self + +-- ImportDeclaration ------------------------------------------- +-- wrapper +data Inh_ImportDeclaration = Inh_ImportDeclaration { } +data Syn_ImportDeclaration = Syn_ImportDeclaration { self_Syn_ImportDeclaration :: (ImportDeclaration) } +{-# INLINABLE wrap_ImportDeclaration #-} +wrap_ImportDeclaration :: T_ImportDeclaration -> Inh_ImportDeclaration -> (Syn_ImportDeclaration ) +wrap_ImportDeclaration (T_ImportDeclaration act) (Inh_ImportDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclaration_vIn70 + (T_ImportDeclaration_vOut70 _lhsOself) <- return (inv_ImportDeclaration_s71 sem arg) + return (Syn_ImportDeclaration _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclaration #-} +sem_ImportDeclaration :: ImportDeclaration -> T_ImportDeclaration +sem_ImportDeclaration ( ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ ) = sem_ImportDeclaration_Import ( sem_Range range_ ) qualified_ ( sem_Name name_ ) ( sem_MaybeName asname_ ) ( sem_MaybeImportSpecification importspecification_ ) +sem_ImportDeclaration ( ImportDeclaration_Empty range_ ) = sem_ImportDeclaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_ImportDeclaration = T_ImportDeclaration { + attach_T_ImportDeclaration :: Identity (T_ImportDeclaration_s71 ) + } +newtype T_ImportDeclaration_s71 = C_ImportDeclaration_s71 { + inv_ImportDeclaration_s71 :: (T_ImportDeclaration_v70 ) + } +data T_ImportDeclaration_s72 = C_ImportDeclaration_s72 +type T_ImportDeclaration_v70 = (T_ImportDeclaration_vIn70 ) -> (T_ImportDeclaration_vOut70 ) +data T_ImportDeclaration_vIn70 = T_ImportDeclaration_vIn70 +data T_ImportDeclaration_vOut70 = T_ImportDeclaration_vOut70 (ImportDeclaration) +{-# NOINLINE sem_ImportDeclaration_Import #-} +sem_ImportDeclaration_Import :: T_Range -> (Bool) -> T_Name -> T_MaybeName -> T_MaybeImportSpecification -> T_ImportDeclaration +sem_ImportDeclaration_Import arg_range_ arg_qualified_ arg_name_ arg_asname_ arg_importspecification_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _asnameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_asname_)) + _importspecificationX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeImportSpecification (arg_importspecification_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeName_vOut103 _asnameIself) = inv_MaybeName_s104 _asnameX104 (T_MaybeName_vIn103 ) + (T_MaybeImportSpecification_vOut97 _importspecificationIself) = inv_MaybeImportSpecification_s98 _importspecificationX98 (T_MaybeImportSpecification_vIn97 ) + _self = rule486 _asnameIself _importspecificationIself _nameIself _rangeIself arg_qualified_ + _lhsOself :: ImportDeclaration + _lhsOself = rule487 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule486 #-} + rule486 = \ ((_asnameIself) :: MaybeName) ((_importspecificationIself) :: MaybeImportSpecification) ((_nameIself) :: Name) ((_rangeIself) :: Range) qualified_ -> + ImportDeclaration_Import _rangeIself qualified_ _nameIself _asnameIself _importspecificationIself + {-# INLINE rule487 #-} + rule487 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclaration_Empty #-} +sem_ImportDeclaration_Empty :: T_Range -> T_ImportDeclaration +sem_ImportDeclaration_Empty arg_range_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule488 _rangeIself + _lhsOself :: ImportDeclaration + _lhsOself = rule489 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule488 #-} + rule488 = \ ((_rangeIself) :: Range) -> + ImportDeclaration_Empty _rangeIself + {-# INLINE rule489 #-} + rule489 = \ _self -> + _self + +-- ImportDeclarations ------------------------------------------ +-- wrapper +data Inh_ImportDeclarations = Inh_ImportDeclarations { } +data Syn_ImportDeclarations = Syn_ImportDeclarations { self_Syn_ImportDeclarations :: (ImportDeclarations) } +{-# INLINABLE wrap_ImportDeclarations #-} +wrap_ImportDeclarations :: T_ImportDeclarations -> Inh_ImportDeclarations -> (Syn_ImportDeclarations ) +wrap_ImportDeclarations (T_ImportDeclarations act) (Inh_ImportDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclarations_vIn73 + (T_ImportDeclarations_vOut73 _lhsOself) <- return (inv_ImportDeclarations_s74 sem arg) + return (Syn_ImportDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclarations #-} +sem_ImportDeclarations :: ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations list = Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list) + +-- semantic domain +newtype T_ImportDeclarations = T_ImportDeclarations { + attach_T_ImportDeclarations :: Identity (T_ImportDeclarations_s74 ) + } +newtype T_ImportDeclarations_s74 = C_ImportDeclarations_s74 { + inv_ImportDeclarations_s74 :: (T_ImportDeclarations_v73 ) + } +data T_ImportDeclarations_s75 = C_ImportDeclarations_s75 +type T_ImportDeclarations_v73 = (T_ImportDeclarations_vIn73 ) -> (T_ImportDeclarations_vOut73 ) +data T_ImportDeclarations_vIn73 = T_ImportDeclarations_vIn73 +data T_ImportDeclarations_vOut73 = T_ImportDeclarations_vOut73 (ImportDeclarations) +{-# NOINLINE sem_ImportDeclarations_Cons #-} +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> T_ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations_Cons arg_hd_ arg_tl_ = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _hdX71 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclaration (arg_hd_)) + _tlX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_tl_)) + (T_ImportDeclaration_vOut70 _hdIself) = inv_ImportDeclaration_s71 _hdX71 (T_ImportDeclaration_vIn70 ) + (T_ImportDeclarations_vOut73 _tlIself) = inv_ImportDeclarations_s74 _tlX74 (T_ImportDeclarations_vIn73 ) + _self = rule490 _hdIself _tlIself + _lhsOself :: ImportDeclarations + _lhsOself = rule491 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule490 #-} + rule490 = \ ((_hdIself) :: ImportDeclaration) ((_tlIself) :: ImportDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule491 #-} + rule491 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclarations_Nil #-} +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _self = rule492 () + _lhsOself :: ImportDeclarations + _lhsOself = rule493 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule492 #-} + rule492 = \ (_ :: ()) -> + [] + {-# INLINE rule493 #-} + rule493 = \ _self -> + _self + +-- ImportSpecification ----------------------------------------- +-- wrapper +data Inh_ImportSpecification = Inh_ImportSpecification { } +data Syn_ImportSpecification = Syn_ImportSpecification { self_Syn_ImportSpecification :: (ImportSpecification) } +{-# INLINABLE wrap_ImportSpecification #-} +wrap_ImportSpecification :: T_ImportSpecification -> Inh_ImportSpecification -> (Syn_ImportSpecification ) +wrap_ImportSpecification (T_ImportSpecification act) (Inh_ImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportSpecification_vIn76 + (T_ImportSpecification_vOut76 _lhsOself) <- return (inv_ImportSpecification_s77 sem arg) + return (Syn_ImportSpecification _lhsOself) + ) + +-- cata +{-# INLINE sem_ImportSpecification #-} +sem_ImportSpecification :: ImportSpecification -> T_ImportSpecification +sem_ImportSpecification ( ImportSpecification_Import range_ hiding_ imports_ ) = sem_ImportSpecification_Import ( sem_Range range_ ) hiding_ ( sem_Imports imports_ ) + +-- semantic domain +newtype T_ImportSpecification = T_ImportSpecification { + attach_T_ImportSpecification :: Identity (T_ImportSpecification_s77 ) + } +newtype T_ImportSpecification_s77 = C_ImportSpecification_s77 { + inv_ImportSpecification_s77 :: (T_ImportSpecification_v76 ) + } +data T_ImportSpecification_s78 = C_ImportSpecification_s78 +type T_ImportSpecification_v76 = (T_ImportSpecification_vIn76 ) -> (T_ImportSpecification_vOut76 ) +data T_ImportSpecification_vIn76 = T_ImportSpecification_vIn76 +data T_ImportSpecification_vOut76 = T_ImportSpecification_vOut76 (ImportSpecification) +{-# NOINLINE sem_ImportSpecification_Import #-} +sem_ImportSpecification_Import :: T_Range -> (Bool) -> T_Imports -> T_ImportSpecification +sem_ImportSpecification_Import arg_range_ arg_hiding_ arg_imports_ = T_ImportSpecification (return st77) where + {-# NOINLINE st77 #-} + st77 = let + v76 :: T_ImportSpecification_v76 + v76 = \ (T_ImportSpecification_vIn76 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importsX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_imports_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Imports_vOut79 _importsIself) = inv_Imports_s80 _importsX80 (T_Imports_vIn79 ) + _self = rule494 _importsIself _rangeIself arg_hiding_ + _lhsOself :: ImportSpecification + _lhsOself = rule495 _self + __result_ = T_ImportSpecification_vOut76 _lhsOself + in __result_ ) + in C_ImportSpecification_s77 v76 + {-# INLINE rule494 #-} + rule494 = \ ((_importsIself) :: Imports) ((_rangeIself) :: Range) hiding_ -> + ImportSpecification_Import _rangeIself hiding_ _importsIself + {-# INLINE rule495 #-} + rule495 = \ _self -> + _self + +-- Imports ----------------------------------------------------- +-- wrapper +data Inh_Imports = Inh_Imports { } +data Syn_Imports = Syn_Imports { self_Syn_Imports :: (Imports) } +{-# INLINABLE wrap_Imports #-} +wrap_Imports :: T_Imports -> Inh_Imports -> (Syn_Imports ) +wrap_Imports (T_Imports act) (Inh_Imports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Imports_vIn79 + (T_Imports_vOut79 _lhsOself) <- return (inv_Imports_s80 sem arg) + return (Syn_Imports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Imports #-} +sem_Imports :: Imports -> T_Imports +sem_Imports list = Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list) + +-- semantic domain +newtype T_Imports = T_Imports { + attach_T_Imports :: Identity (T_Imports_s80 ) + } +newtype T_Imports_s80 = C_Imports_s80 { + inv_Imports_s80 :: (T_Imports_v79 ) + } +data T_Imports_s81 = C_Imports_s81 +type T_Imports_v79 = (T_Imports_vIn79 ) -> (T_Imports_vOut79 ) +data T_Imports_vIn79 = T_Imports_vIn79 +data T_Imports_vOut79 = T_Imports_vOut79 (Imports) +{-# NOINLINE sem_Imports_Cons #-} +sem_Imports_Cons :: T_Import -> T_Imports -> T_Imports +sem_Imports_Cons arg_hd_ arg_tl_ = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _hdX68 = Control.Monad.Identity.runIdentity (attach_T_Import (arg_hd_)) + _tlX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_tl_)) + (T_Import_vOut67 _hdIself) = inv_Import_s68 _hdX68 (T_Import_vIn67 ) + (T_Imports_vOut79 _tlIself) = inv_Imports_s80 _tlX80 (T_Imports_vIn79 ) + _self = rule496 _hdIself _tlIself + _lhsOself :: Imports + _lhsOself = rule497 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule496 #-} + rule496 = \ ((_hdIself) :: Import) ((_tlIself) :: Imports) -> + (:) _hdIself _tlIself + {-# INLINE rule497 #-} + rule497 = \ _self -> + _self +{-# NOINLINE sem_Imports_Nil #-} +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _self = rule498 () + _lhsOself :: Imports + _lhsOself = rule499 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule498 #-} + rule498 = \ (_ :: ()) -> + [] + {-# INLINE rule499 #-} + rule499 = \ _self -> + _self + +-- LeftHandSide ------------------------------------------------ +-- wrapper +data Inh_LeftHandSide = Inh_LeftHandSide { } +data Syn_LeftHandSide = Syn_LeftHandSide { self_Syn_LeftHandSide :: (LeftHandSide) } +{-# INLINABLE wrap_LeftHandSide #-} +wrap_LeftHandSide :: T_LeftHandSide -> Inh_LeftHandSide -> (Syn_LeftHandSide ) +wrap_LeftHandSide (T_LeftHandSide act) (Inh_LeftHandSide ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_LeftHandSide_vIn82 + (T_LeftHandSide_vOut82 _lhsOself) <- return (inv_LeftHandSide_s83 sem arg) + return (Syn_LeftHandSide _lhsOself) + ) + +-- cata +{-# NOINLINE sem_LeftHandSide #-} +sem_LeftHandSide :: LeftHandSide -> T_LeftHandSide +sem_LeftHandSide ( LeftHandSide_Function range_ name_ patterns_ ) = sem_LeftHandSide_Function ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_LeftHandSide ( LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ ) = sem_LeftHandSide_Infix ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name operator_ ) ( sem_Pattern rightPattern_ ) +sem_LeftHandSide ( LeftHandSide_Parenthesized range_ lefthandside_ patterns_ ) = sem_LeftHandSide_Parenthesized ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_Patterns patterns_ ) + +-- semantic domain +newtype T_LeftHandSide = T_LeftHandSide { + attach_T_LeftHandSide :: Identity (T_LeftHandSide_s83 ) + } +newtype T_LeftHandSide_s83 = C_LeftHandSide_s83 { + inv_LeftHandSide_s83 :: (T_LeftHandSide_v82 ) + } +data T_LeftHandSide_s84 = C_LeftHandSide_s84 +type T_LeftHandSide_v82 = (T_LeftHandSide_vIn82 ) -> (T_LeftHandSide_vOut82 ) +data T_LeftHandSide_vIn82 = T_LeftHandSide_vIn82 +data T_LeftHandSide_vOut82 = T_LeftHandSide_vOut82 (LeftHandSide) +{-# NOINLINE sem_LeftHandSide_Function #-} +sem_LeftHandSide_Function :: T_Range -> T_Name -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Function arg_range_ arg_name_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _self = rule500 _nameIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule501 _self + __result_ = T_LeftHandSide_vOut82 _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule500 #-} + rule500 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Function _rangeIself _nameIself _patternsIself + {-# INLINE rule501 #-} + rule501 = \ _self -> + _self +{-# NOINLINE sem_LeftHandSide_Infix #-} +sem_LeftHandSide_Infix :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_LeftHandSide +sem_LeftHandSide_Infix arg_range_ arg_leftPattern_ arg_operator_ arg_rightPattern_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _operatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_operator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIself) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 ) + (T_Name_vOut112 _operatorIself) = inv_Name_s113 _operatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIself) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 ) + _self = rule502 _leftPatternIself _operatorIself _rangeIself _rightPatternIself + _lhsOself :: LeftHandSide + _lhsOself = rule503 _self + __result_ = T_LeftHandSide_vOut82 _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule502 #-} + rule502 = \ ((_leftPatternIself) :: Pattern) ((_operatorIself) :: Name) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + LeftHandSide_Infix _rangeIself _leftPatternIself _operatorIself _rightPatternIself + {-# INLINE rule503 #-} + rule503 = \ _self -> + _self +{-# NOINLINE sem_LeftHandSide_Parenthesized #-} +sem_LeftHandSide_Parenthesized :: T_Range -> T_LeftHandSide -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Parenthesized arg_range_ arg_lefthandside_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIself) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _self = rule504 _lefthandsideIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule505 _self + __result_ = T_LeftHandSide_vOut82 _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule504 #-} + rule504 = \ ((_lefthandsideIself) :: LeftHandSide) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Parenthesized _rangeIself _lefthandsideIself _patternsIself + {-# INLINE rule505 #-} + rule505 = \ _self -> + _self + +-- Literal ----------------------------------------------------- +-- wrapper +data Inh_Literal = Inh_Literal { } +data Syn_Literal = Syn_Literal { self_Syn_Literal :: (Literal) } +{-# INLINABLE wrap_Literal #-} +wrap_Literal :: T_Literal -> Inh_Literal -> (Syn_Literal ) +wrap_Literal (T_Literal act) (Inh_Literal ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Literal_vIn85 + (T_Literal_vOut85 _lhsOself) <- return (inv_Literal_s86 sem arg) + return (Syn_Literal _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Literal #-} +sem_Literal :: Literal -> T_Literal +sem_Literal ( Literal_Int range_ value_ ) = sem_Literal_Int ( sem_Range range_ ) value_ +sem_Literal ( Literal_Char range_ value_ ) = sem_Literal_Char ( sem_Range range_ ) value_ +sem_Literal ( Literal_Float range_ value_ ) = sem_Literal_Float ( sem_Range range_ ) value_ +sem_Literal ( Literal_String range_ value_ ) = sem_Literal_String ( sem_Range range_ ) value_ + +-- semantic domain +newtype T_Literal = T_Literal { + attach_T_Literal :: Identity (T_Literal_s86 ) + } +newtype T_Literal_s86 = C_Literal_s86 { + inv_Literal_s86 :: (T_Literal_v85 ) + } +data T_Literal_s87 = C_Literal_s87 +type T_Literal_v85 = (T_Literal_vIn85 ) -> (T_Literal_vOut85 ) +data T_Literal_vIn85 = T_Literal_vIn85 +data T_Literal_vOut85 = T_Literal_vOut85 (Literal) +{-# NOINLINE sem_Literal_Int #-} +sem_Literal_Int :: T_Range -> (String) -> T_Literal +sem_Literal_Int arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule506 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule507 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule506 #-} + rule506 = \ ((_rangeIself) :: Range) value_ -> + Literal_Int _rangeIself value_ + {-# INLINE rule507 #-} + rule507 = \ _self -> + _self +{-# NOINLINE sem_Literal_Char #-} +sem_Literal_Char :: T_Range -> (String) -> T_Literal +sem_Literal_Char arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule508 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule509 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule508 #-} + rule508 = \ ((_rangeIself) :: Range) value_ -> + Literal_Char _rangeIself value_ + {-# INLINE rule509 #-} + rule509 = \ _self -> + _self +{-# NOINLINE sem_Literal_Float #-} +sem_Literal_Float :: T_Range -> (String) -> T_Literal +sem_Literal_Float arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule510 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule511 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule510 #-} + rule510 = \ ((_rangeIself) :: Range) value_ -> + Literal_Float _rangeIself value_ + {-# INLINE rule511 #-} + rule511 = \ _self -> + _self +{-# NOINLINE sem_Literal_String #-} +sem_Literal_String :: T_Range -> (String) -> T_Literal +sem_Literal_String arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule512 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule513 _self + __result_ = T_Literal_vOut85 _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule512 #-} + rule512 = \ ((_rangeIself) :: Range) value_ -> + Literal_String _rangeIself value_ + {-# INLINE rule513 #-} + rule513 = \ _self -> + _self + +-- MaybeDeclarations ------------------------------------------- +-- wrapper +data Inh_MaybeDeclarations = Inh_MaybeDeclarations { bindingGroups_Inh_MaybeDeclarations :: (BindingGroups), kappaUnique_Inh_MaybeDeclarations :: (Int) } +data Syn_MaybeDeclarations = Syn_MaybeDeclarations { bindingGroups_Syn_MaybeDeclarations :: (BindingGroups), kappaUnique_Syn_MaybeDeclarations :: (Int), self_Syn_MaybeDeclarations :: (MaybeDeclarations) } +{-# INLINABLE wrap_MaybeDeclarations #-} +wrap_MaybeDeclarations :: T_MaybeDeclarations -> Inh_MaybeDeclarations -> (Syn_MaybeDeclarations ) +wrap_MaybeDeclarations (T_MaybeDeclarations act) (Inh_MaybeDeclarations _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeDeclarations_vIn88 _lhsIbindingGroups _lhsIkappaUnique + (T_MaybeDeclarations_vOut88 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_MaybeDeclarations_s89 sem arg) + return (Syn_MaybeDeclarations _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeDeclarations #-} +sem_MaybeDeclarations :: MaybeDeclarations -> T_MaybeDeclarations +sem_MaybeDeclarations ( MaybeDeclarations_Nothing ) = sem_MaybeDeclarations_Nothing +sem_MaybeDeclarations ( MaybeDeclarations_Just declarations_ ) = sem_MaybeDeclarations_Just ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_MaybeDeclarations = T_MaybeDeclarations { + attach_T_MaybeDeclarations :: Identity (T_MaybeDeclarations_s89 ) + } +newtype T_MaybeDeclarations_s89 = C_MaybeDeclarations_s89 { + inv_MaybeDeclarations_s89 :: (T_MaybeDeclarations_v88 ) + } +data T_MaybeDeclarations_s90 = C_MaybeDeclarations_s90 +type T_MaybeDeclarations_v88 = (T_MaybeDeclarations_vIn88 ) -> (T_MaybeDeclarations_vOut88 ) +data T_MaybeDeclarations_vIn88 = T_MaybeDeclarations_vIn88 (BindingGroups) (Int) +data T_MaybeDeclarations_vOut88 = T_MaybeDeclarations_vOut88 (BindingGroups) (Int) (MaybeDeclarations) +{-# NOINLINE sem_MaybeDeclarations_Nothing #-} +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _self = rule514 () + _lhsOself :: MaybeDeclarations + _lhsOself = rule515 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule516 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule517 _lhsIkappaUnique + __result_ = T_MaybeDeclarations_vOut88 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule514 #-} + rule514 = \ (_ :: ()) -> + MaybeDeclarations_Nothing + {-# INLINE rule515 #-} + rule515 = \ _self -> + _self + {-# INLINE rule516 #-} + rule516 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule517 #-} + rule517 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_MaybeDeclarations_Just #-} +sem_MaybeDeclarations_Just :: T_Declarations -> T_MaybeDeclarations +sem_MaybeDeclarations_Just arg_declarations_ = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Declarations_vOut31 _declarationsIbindingGroups _declarationsIkappaUnique _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsObindingGroups _declarationsOkappaUnique) + _self = rule518 _declarationsIself + _lhsOself :: MaybeDeclarations + _lhsOself = rule519 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule520 _declarationsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule521 _declarationsIkappaUnique + _declarationsObindingGroups = rule522 _lhsIbindingGroups + _declarationsOkappaUnique = rule523 _lhsIkappaUnique + __result_ = T_MaybeDeclarations_vOut88 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule518 #-} + rule518 = \ ((_declarationsIself) :: Declarations) -> + MaybeDeclarations_Just _declarationsIself + {-# INLINE rule519 #-} + rule519 = \ _self -> + _self + {-# INLINE rule520 #-} + rule520 = \ ((_declarationsIbindingGroups) :: BindingGroups) -> + _declarationsIbindingGroups + {-# INLINE rule521 #-} + rule521 = \ ((_declarationsIkappaUnique) :: Int) -> + _declarationsIkappaUnique + {-# INLINE rule522 #-} + rule522 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule523 #-} + rule523 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- MaybeExports ------------------------------------------------ +-- wrapper +data Inh_MaybeExports = Inh_MaybeExports { } +data Syn_MaybeExports = Syn_MaybeExports { self_Syn_MaybeExports :: (MaybeExports) } +{-# INLINABLE wrap_MaybeExports #-} +wrap_MaybeExports :: T_MaybeExports -> Inh_MaybeExports -> (Syn_MaybeExports ) +wrap_MaybeExports (T_MaybeExports act) (Inh_MaybeExports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExports_vIn91 + (T_MaybeExports_vOut91 _lhsOself) <- return (inv_MaybeExports_s92 sem arg) + return (Syn_MaybeExports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExports #-} +sem_MaybeExports :: MaybeExports -> T_MaybeExports +sem_MaybeExports ( MaybeExports_Nothing ) = sem_MaybeExports_Nothing +sem_MaybeExports ( MaybeExports_Just exports_ ) = sem_MaybeExports_Just ( sem_Exports exports_ ) + +-- semantic domain +newtype T_MaybeExports = T_MaybeExports { + attach_T_MaybeExports :: Identity (T_MaybeExports_s92 ) + } +newtype T_MaybeExports_s92 = C_MaybeExports_s92 { + inv_MaybeExports_s92 :: (T_MaybeExports_v91 ) + } +data T_MaybeExports_s93 = C_MaybeExports_s93 +type T_MaybeExports_v91 = (T_MaybeExports_vIn91 ) -> (T_MaybeExports_vOut91 ) +data T_MaybeExports_vIn91 = T_MaybeExports_vIn91 +data T_MaybeExports_vOut91 = T_MaybeExports_vOut91 (MaybeExports) +{-# NOINLINE sem_MaybeExports_Nothing #-} +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _self = rule524 () + _lhsOself :: MaybeExports + _lhsOself = rule525 _self + __result_ = T_MaybeExports_vOut91 _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule524 #-} + rule524 = \ (_ :: ()) -> + MaybeExports_Nothing + {-# INLINE rule525 #-} + rule525 = \ _self -> + _self +{-# NOINLINE sem_MaybeExports_Just #-} +sem_MaybeExports_Just :: T_Exports -> T_MaybeExports +sem_MaybeExports_Just arg_exports_ = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _exportsX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_exports_)) + (T_Exports_vOut37 _exportsIself) = inv_Exports_s38 _exportsX38 (T_Exports_vIn37 ) + _self = rule526 _exportsIself + _lhsOself :: MaybeExports + _lhsOself = rule527 _self + __result_ = T_MaybeExports_vOut91 _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule526 #-} + rule526 = \ ((_exportsIself) :: Exports) -> + MaybeExports_Just _exportsIself + {-# INLINE rule527 #-} + rule527 = \ _self -> + _self + +-- MaybeExpression --------------------------------------------- +-- wrapper +data Inh_MaybeExpression = Inh_MaybeExpression { bindingGroups_Inh_MaybeExpression :: (BindingGroups), kappaUnique_Inh_MaybeExpression :: (Int) } +data Syn_MaybeExpression = Syn_MaybeExpression { bindingGroups_Syn_MaybeExpression :: (BindingGroups), kappaUnique_Syn_MaybeExpression :: (Int), self_Syn_MaybeExpression :: (MaybeExpression) } +{-# INLINABLE wrap_MaybeExpression #-} +wrap_MaybeExpression :: T_MaybeExpression -> Inh_MaybeExpression -> (Syn_MaybeExpression ) +wrap_MaybeExpression (T_MaybeExpression act) (Inh_MaybeExpression _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExpression_vIn94 _lhsIbindingGroups _lhsIkappaUnique + (T_MaybeExpression_vOut94 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_MaybeExpression_s95 sem arg) + return (Syn_MaybeExpression _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExpression #-} +sem_MaybeExpression :: MaybeExpression -> T_MaybeExpression +sem_MaybeExpression ( MaybeExpression_Nothing ) = sem_MaybeExpression_Nothing +sem_MaybeExpression ( MaybeExpression_Just expression_ ) = sem_MaybeExpression_Just ( sem_Expression expression_ ) + +-- semantic domain +newtype T_MaybeExpression = T_MaybeExpression { + attach_T_MaybeExpression :: Identity (T_MaybeExpression_s95 ) + } +newtype T_MaybeExpression_s95 = C_MaybeExpression_s95 { + inv_MaybeExpression_s95 :: (T_MaybeExpression_v94 ) + } +data T_MaybeExpression_s96 = C_MaybeExpression_s96 +type T_MaybeExpression_v94 = (T_MaybeExpression_vIn94 ) -> (T_MaybeExpression_vOut94 ) +data T_MaybeExpression_vIn94 = T_MaybeExpression_vIn94 (BindingGroups) (Int) +data T_MaybeExpression_vOut94 = T_MaybeExpression_vOut94 (BindingGroups) (Int) (MaybeExpression) +{-# NOINLINE sem_MaybeExpression_Nothing #-} +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _self = rule528 () + _lhsOself :: MaybeExpression + _lhsOself = rule529 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule530 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule531 _lhsIkappaUnique + __result_ = T_MaybeExpression_vOut94 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule528 #-} + rule528 = \ (_ :: ()) -> + MaybeExpression_Nothing + {-# INLINE rule529 #-} + rule529 = \ _self -> + _self + {-# INLINE rule530 #-} + rule530 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule531 #-} + rule531 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_MaybeExpression_Just #-} +sem_MaybeExpression_Just :: T_Expression -> T_MaybeExpression +sem_MaybeExpression_Just arg_expression_ = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule532 _expressionIself + _lhsOself :: MaybeExpression + _lhsOself = rule533 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule534 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule535 _expressionIkappaUnique + _expressionObindingGroups = rule536 _lhsIbindingGroups + _expressionOkappaUnique = rule537 _lhsIkappaUnique + __result_ = T_MaybeExpression_vOut94 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule532 #-} + rule532 = \ ((_expressionIself) :: Expression) -> + MaybeExpression_Just _expressionIself + {-# INLINE rule533 #-} + rule533 = \ _self -> + _self + {-# INLINE rule534 #-} + rule534 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule535 #-} + rule535 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule536 #-} + rule536 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule537 #-} + rule537 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- MaybeImportSpecification ------------------------------------ +-- wrapper +data Inh_MaybeImportSpecification = Inh_MaybeImportSpecification { } +data Syn_MaybeImportSpecification = Syn_MaybeImportSpecification { self_Syn_MaybeImportSpecification :: (MaybeImportSpecification) } +{-# INLINABLE wrap_MaybeImportSpecification #-} +wrap_MaybeImportSpecification :: T_MaybeImportSpecification -> Inh_MaybeImportSpecification -> (Syn_MaybeImportSpecification ) +wrap_MaybeImportSpecification (T_MaybeImportSpecification act) (Inh_MaybeImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeImportSpecification_vIn97 + (T_MaybeImportSpecification_vOut97 _lhsOself) <- return (inv_MaybeImportSpecification_s98 sem arg) + return (Syn_MaybeImportSpecification _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeImportSpecification #-} +sem_MaybeImportSpecification :: MaybeImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification ( MaybeImportSpecification_Nothing ) = sem_MaybeImportSpecification_Nothing +sem_MaybeImportSpecification ( MaybeImportSpecification_Just importspecification_ ) = sem_MaybeImportSpecification_Just ( sem_ImportSpecification importspecification_ ) + +-- semantic domain +newtype T_MaybeImportSpecification = T_MaybeImportSpecification { + attach_T_MaybeImportSpecification :: Identity (T_MaybeImportSpecification_s98 ) + } +newtype T_MaybeImportSpecification_s98 = C_MaybeImportSpecification_s98 { + inv_MaybeImportSpecification_s98 :: (T_MaybeImportSpecification_v97 ) + } +data T_MaybeImportSpecification_s99 = C_MaybeImportSpecification_s99 +type T_MaybeImportSpecification_v97 = (T_MaybeImportSpecification_vIn97 ) -> (T_MaybeImportSpecification_vOut97 ) +data T_MaybeImportSpecification_vIn97 = T_MaybeImportSpecification_vIn97 +data T_MaybeImportSpecification_vOut97 = T_MaybeImportSpecification_vOut97 (MaybeImportSpecification) +{-# NOINLINE sem_MaybeImportSpecification_Nothing #-} +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _self = rule538 () + _lhsOself :: MaybeImportSpecification + _lhsOself = rule539 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule538 #-} + rule538 = \ (_ :: ()) -> + MaybeImportSpecification_Nothing + {-# INLINE rule539 #-} + rule539 = \ _self -> + _self +{-# NOINLINE sem_MaybeImportSpecification_Just #-} +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification_Just arg_importspecification_ = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _importspecificationX77 = Control.Monad.Identity.runIdentity (attach_T_ImportSpecification (arg_importspecification_)) + (T_ImportSpecification_vOut76 _importspecificationIself) = inv_ImportSpecification_s77 _importspecificationX77 (T_ImportSpecification_vIn76 ) + _self = rule540 _importspecificationIself + _lhsOself :: MaybeImportSpecification + _lhsOself = rule541 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule540 #-} + rule540 = \ ((_importspecificationIself) :: ImportSpecification) -> + MaybeImportSpecification_Just _importspecificationIself + {-# INLINE rule541 #-} + rule541 = \ _self -> + _self + +-- MaybeInt ---------------------------------------------------- +-- wrapper +data Inh_MaybeInt = Inh_MaybeInt { } +data Syn_MaybeInt = Syn_MaybeInt { self_Syn_MaybeInt :: (MaybeInt) } +{-# INLINABLE wrap_MaybeInt #-} +wrap_MaybeInt :: T_MaybeInt -> Inh_MaybeInt -> (Syn_MaybeInt ) +wrap_MaybeInt (T_MaybeInt act) (Inh_MaybeInt ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeInt_vIn100 + (T_MaybeInt_vOut100 _lhsOself) <- return (inv_MaybeInt_s101 sem arg) + return (Syn_MaybeInt _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeInt #-} +sem_MaybeInt :: MaybeInt -> T_MaybeInt +sem_MaybeInt ( MaybeInt_Nothing ) = sem_MaybeInt_Nothing +sem_MaybeInt ( MaybeInt_Just int_ ) = sem_MaybeInt_Just int_ + +-- semantic domain +newtype T_MaybeInt = T_MaybeInt { + attach_T_MaybeInt :: Identity (T_MaybeInt_s101 ) + } +newtype T_MaybeInt_s101 = C_MaybeInt_s101 { + inv_MaybeInt_s101 :: (T_MaybeInt_v100 ) + } +data T_MaybeInt_s102 = C_MaybeInt_s102 +type T_MaybeInt_v100 = (T_MaybeInt_vIn100 ) -> (T_MaybeInt_vOut100 ) +data T_MaybeInt_vIn100 = T_MaybeInt_vIn100 +data T_MaybeInt_vOut100 = T_MaybeInt_vOut100 (MaybeInt) +{-# NOINLINE sem_MaybeInt_Nothing #-} +sem_MaybeInt_Nothing :: T_MaybeInt +sem_MaybeInt_Nothing = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule542 () + _lhsOself :: MaybeInt + _lhsOself = rule543 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule542 #-} + rule542 = \ (_ :: ()) -> + MaybeInt_Nothing + {-# INLINE rule543 #-} + rule543 = \ _self -> + _self +{-# NOINLINE sem_MaybeInt_Just #-} +sem_MaybeInt_Just :: (Int) -> T_MaybeInt +sem_MaybeInt_Just arg_int_ = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule544 arg_int_ + _lhsOself :: MaybeInt + _lhsOself = rule545 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule544 #-} + rule544 = \ int_ -> + MaybeInt_Just int_ + {-# INLINE rule545 #-} + rule545 = \ _self -> + _self + +-- MaybeName --------------------------------------------------- +-- wrapper +data Inh_MaybeName = Inh_MaybeName { } +data Syn_MaybeName = Syn_MaybeName { self_Syn_MaybeName :: (MaybeName) } +{-# INLINABLE wrap_MaybeName #-} +wrap_MaybeName :: T_MaybeName -> Inh_MaybeName -> (Syn_MaybeName ) +wrap_MaybeName (T_MaybeName act) (Inh_MaybeName ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeName_vIn103 + (T_MaybeName_vOut103 _lhsOself) <- return (inv_MaybeName_s104 sem arg) + return (Syn_MaybeName _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeName #-} +sem_MaybeName :: MaybeName -> T_MaybeName +sem_MaybeName ( MaybeName_Nothing ) = sem_MaybeName_Nothing +sem_MaybeName ( MaybeName_Just name_ ) = sem_MaybeName_Just ( sem_Name name_ ) + +-- semantic domain +newtype T_MaybeName = T_MaybeName { + attach_T_MaybeName :: Identity (T_MaybeName_s104 ) + } +newtype T_MaybeName_s104 = C_MaybeName_s104 { + inv_MaybeName_s104 :: (T_MaybeName_v103 ) + } +data T_MaybeName_s105 = C_MaybeName_s105 +type T_MaybeName_v103 = (T_MaybeName_vIn103 ) -> (T_MaybeName_vOut103 ) +data T_MaybeName_vIn103 = T_MaybeName_vIn103 +data T_MaybeName_vOut103 = T_MaybeName_vOut103 (MaybeName) +{-# NOINLINE sem_MaybeName_Nothing #-} +sem_MaybeName_Nothing :: T_MaybeName +sem_MaybeName_Nothing = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _self = rule546 () + _lhsOself :: MaybeName + _lhsOself = rule547 _self + __result_ = T_MaybeName_vOut103 _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule546 #-} + rule546 = \ (_ :: ()) -> + MaybeName_Nothing + {-# INLINE rule547 #-} + rule547 = \ _self -> + _self +{-# NOINLINE sem_MaybeName_Just #-} +sem_MaybeName_Just :: T_Name -> T_MaybeName +sem_MaybeName_Just arg_name_ = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule548 _nameIself + _lhsOself :: MaybeName + _lhsOself = rule549 _self + __result_ = T_MaybeName_vOut103 _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule548 #-} + rule548 = \ ((_nameIself) :: Name) -> + MaybeName_Just _nameIself + {-# INLINE rule549 #-} + rule549 = \ _self -> + _self + +-- MaybeNames -------------------------------------------------- +-- wrapper +data Inh_MaybeNames = Inh_MaybeNames { } +data Syn_MaybeNames = Syn_MaybeNames { self_Syn_MaybeNames :: (MaybeNames) } +{-# INLINABLE wrap_MaybeNames #-} +wrap_MaybeNames :: T_MaybeNames -> Inh_MaybeNames -> (Syn_MaybeNames ) +wrap_MaybeNames (T_MaybeNames act) (Inh_MaybeNames ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeNames_vIn106 + (T_MaybeNames_vOut106 _lhsOself) <- return (inv_MaybeNames_s107 sem arg) + return (Syn_MaybeNames _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeNames #-} +sem_MaybeNames :: MaybeNames -> T_MaybeNames +sem_MaybeNames ( MaybeNames_Nothing ) = sem_MaybeNames_Nothing +sem_MaybeNames ( MaybeNames_Just names_ ) = sem_MaybeNames_Just ( sem_Names names_ ) + +-- semantic domain +newtype T_MaybeNames = T_MaybeNames { + attach_T_MaybeNames :: Identity (T_MaybeNames_s107 ) + } +newtype T_MaybeNames_s107 = C_MaybeNames_s107 { + inv_MaybeNames_s107 :: (T_MaybeNames_v106 ) + } +data T_MaybeNames_s108 = C_MaybeNames_s108 +type T_MaybeNames_v106 = (T_MaybeNames_vIn106 ) -> (T_MaybeNames_vOut106 ) +data T_MaybeNames_vIn106 = T_MaybeNames_vIn106 +data T_MaybeNames_vOut106 = T_MaybeNames_vOut106 (MaybeNames) +{-# NOINLINE sem_MaybeNames_Nothing #-} +sem_MaybeNames_Nothing :: T_MaybeNames +sem_MaybeNames_Nothing = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _self = rule550 () + _lhsOself :: MaybeNames + _lhsOself = rule551 _self + __result_ = T_MaybeNames_vOut106 _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule550 #-} + rule550 = \ (_ :: ()) -> + MaybeNames_Nothing + {-# INLINE rule551 #-} + rule551 = \ _self -> + _self +{-# NOINLINE sem_MaybeNames_Just #-} +sem_MaybeNames_Just :: T_Names -> T_MaybeNames +sem_MaybeNames_Just arg_names_ = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + _self = rule552 _namesIself + _lhsOself :: MaybeNames + _lhsOself = rule553 _self + __result_ = T_MaybeNames_vOut106 _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule552 #-} + rule552 = \ ((_namesIself) :: Names) -> + MaybeNames_Just _namesIself + {-# INLINE rule553 #-} + rule553 = \ _self -> + _self + +-- Module ------------------------------------------------------ +-- wrapper +data Inh_Module = Inh_Module { importEnvironment_Inh_Module :: (ImportEnvironment), options_Inh_Module :: ([Option]) } +data Syn_Module = Syn_Module { debugIO_Syn_Module :: (IO ()), kindEnvironment_Syn_Module :: (KindEnvironment), kindErrors_Syn_Module :: (KindErrors), self_Syn_Module :: (Module) } +{-# INLINABLE wrap_Module #-} +wrap_Module :: T_Module -> Inh_Module -> (Syn_Module ) +wrap_Module (T_Module act) (Inh_Module _lhsIimportEnvironment _lhsIoptions) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Module_vIn109 _lhsIimportEnvironment _lhsIoptions + (T_Module_vOut109 _lhsOdebugIO _lhsOkindEnvironment _lhsOkindErrors _lhsOself) <- return (inv_Module_s110 sem arg) + return (Syn_Module _lhsOdebugIO _lhsOkindEnvironment _lhsOkindErrors _lhsOself) + ) + +-- cata +{-# INLINE sem_Module #-} +sem_Module :: Module -> T_Module +sem_Module ( Module_Module range_ name_ exports_ body_ ) = sem_Module_Module ( sem_Range range_ ) ( sem_MaybeName name_ ) ( sem_MaybeExports exports_ ) ( sem_Body body_ ) + +-- semantic domain +newtype T_Module = T_Module { + attach_T_Module :: Identity (T_Module_s110 ) + } +newtype T_Module_s110 = C_Module_s110 { + inv_Module_s110 :: (T_Module_v109 ) + } +data T_Module_s111 = C_Module_s111 +type T_Module_v109 = (T_Module_vIn109 ) -> (T_Module_vOut109 ) +data T_Module_vIn109 = T_Module_vIn109 (ImportEnvironment) ([Option]) +data T_Module_vOut109 = T_Module_vOut109 (IO ()) (KindEnvironment) (KindErrors) (Module) +{-# NOINLINE sem_Module_Module #-} +sem_Module_Module :: T_Range -> T_MaybeName -> T_MaybeExports -> T_Body -> T_Module +sem_Module_Module arg_range_ arg_name_ arg_exports_ arg_body_ = T_Module (return st110) where + {-# NOINLINE st110 #-} + st110 = let + v109 :: T_Module_v109 + v109 = \ (T_Module_vIn109 _lhsIimportEnvironment _lhsIoptions) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_name_)) + _exportsX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeExports (arg_exports_)) + _bodyX14 = Control.Monad.Identity.runIdentity (attach_T_Body (arg_body_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeName_vOut103 _nameIself) = inv_MaybeName_s104 _nameX104 (T_MaybeName_vIn103 ) + (T_MaybeExports_vOut91 _exportsIself) = inv_MaybeExports_s92 _exportsX92 (T_MaybeExports_vIn91 ) + (T_Body_vOut13 _bodyIconstraints _bodyIenvironment _bodyIkappaUnique _bodyIself) = inv_Body_s14 _bodyX14 (T_Body_vIn13 _bodyOimportEnvironment _bodyOkappaUnique) + _lhsOkindErrors :: KindErrors + _lhsOkindErrors = rule554 _kindErrors _substitution + _lhsOdebugIO :: IO () + _lhsOdebugIO = rule555 _logEntries + _bodyOkappaUnique = rule556 () + ((SolveResult _kappaUniqueAtTheEnd _substitution _ _ _kindErrors),_logEntries) = rule557 _bodyIconstraints _bodyIkappaUnique + _kindEnvironment = rule558 _bodyIenvironment _substitution + _self = rule559 _bodyIself _exportsIself _nameIself _rangeIself + _lhsOself :: Module + _lhsOself = rule560 _self + _lhsOkindEnvironment :: KindEnvironment + _lhsOkindEnvironment = rule561 _kindEnvironment + _bodyOimportEnvironment = rule562 _lhsIimportEnvironment + __result_ = T_Module_vOut109 _lhsOdebugIO _lhsOkindEnvironment _lhsOkindErrors _lhsOself + in __result_ ) + in C_Module_s110 v109 + {-# INLINE rule554 #-} + rule554 = \ _kindErrors _substitution -> + _substitution |-> (map fst _kindErrors) + {-# INLINE rule555 #-} + rule555 = \ _logEntries -> + putStrLn (show _logEntries) + {-# INLINE rule556 #-} + rule556 = \ (_ :: ()) -> + 0 + {-# INLINE rule557 #-} + rule557 = \ ((_bodyIconstraints) :: KindConstraints) ((_bodyIkappaUnique) :: Int) -> + solve (solveOptions { uniqueCounter = _bodyIkappaUnique }) _bodyIconstraints greedyConstraintSolver + {-# INLINE rule558 #-} + rule558 = \ ((_bodyIenvironment) :: PatternAssumptions) _substitution -> + let f kind = generalizeAll ([] .=>. defaultToStar (_substitution |-> kind)) + in M.map f _bodyIenvironment + {-# INLINE rule559 #-} + rule559 = \ ((_bodyIself) :: Body) ((_exportsIself) :: MaybeExports) ((_nameIself) :: MaybeName) ((_rangeIself) :: Range) -> + Module_Module _rangeIself _nameIself _exportsIself _bodyIself + {-# INLINE rule560 #-} + rule560 = \ _self -> + _self + {-# INLINE rule561 #-} + rule561 = \ _kindEnvironment -> + _kindEnvironment + {-# INLINE rule562 #-} + rule562 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + +-- Name -------------------------------------------------------- +-- wrapper +data Inh_Name = Inh_Name { } +data Syn_Name = Syn_Name { self_Syn_Name :: (Name) } +{-# INLINABLE wrap_Name #-} +wrap_Name :: T_Name -> Inh_Name -> (Syn_Name ) +wrap_Name (T_Name act) (Inh_Name ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Name_vIn112 + (T_Name_vOut112 _lhsOself) <- return (inv_Name_s113 sem arg) + return (Syn_Name _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Name #-} +sem_Name :: Name -> T_Name +sem_Name ( Name_Identifier range_ module_ name_ ) = sem_Name_Identifier ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Operator range_ module_ name_ ) = sem_Name_Operator ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Special range_ module_ name_ ) = sem_Name_Special ( sem_Range range_ ) ( sem_Strings module_ ) name_ + +-- semantic domain +newtype T_Name = T_Name { + attach_T_Name :: Identity (T_Name_s113 ) + } +newtype T_Name_s113 = C_Name_s113 { + inv_Name_s113 :: (T_Name_v112 ) + } +data T_Name_s114 = C_Name_s114 +type T_Name_v112 = (T_Name_vIn112 ) -> (T_Name_vOut112 ) +data T_Name_vIn112 = T_Name_vIn112 +data T_Name_vOut112 = T_Name_vOut112 (Name) +{-# NOINLINE sem_Name_Identifier #-} +sem_Name_Identifier :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Identifier arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule563 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule564 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule563 #-} + rule563 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Identifier _rangeIself _moduleIself name_ + {-# INLINE rule564 #-} + rule564 = \ _self -> + _self +{-# NOINLINE sem_Name_Operator #-} +sem_Name_Operator :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Operator arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule565 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule566 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule565 #-} + rule565 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Operator _rangeIself _moduleIself name_ + {-# INLINE rule566 #-} + rule566 = \ _self -> + _self +{-# NOINLINE sem_Name_Special #-} +sem_Name_Special :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Special arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule567 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule568 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule567 #-} + rule567 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Special _rangeIself _moduleIself name_ + {-# INLINE rule568 #-} + rule568 = \ _self -> + _self + +-- Names ------------------------------------------------------- +-- wrapper +data Inh_Names = Inh_Names { } +data Syn_Names = Syn_Names { self_Syn_Names :: (Names) } +{-# INLINABLE wrap_Names #-} +wrap_Names :: T_Names -> Inh_Names -> (Syn_Names ) +wrap_Names (T_Names act) (Inh_Names ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Names_vIn115 + (T_Names_vOut115 _lhsOself) <- return (inv_Names_s116 sem arg) + return (Syn_Names _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Names #-} +sem_Names :: Names -> T_Names +sem_Names list = Prelude.foldr sem_Names_Cons sem_Names_Nil (Prelude.map sem_Name list) + +-- semantic domain +newtype T_Names = T_Names { + attach_T_Names :: Identity (T_Names_s116 ) + } +newtype T_Names_s116 = C_Names_s116 { + inv_Names_s116 :: (T_Names_v115 ) + } +data T_Names_s117 = C_Names_s117 +type T_Names_v115 = (T_Names_vIn115 ) -> (T_Names_vOut115 ) +data T_Names_vIn115 = T_Names_vIn115 +data T_Names_vOut115 = T_Names_vOut115 (Names) +{-# NOINLINE sem_Names_Cons #-} +sem_Names_Cons :: T_Name -> T_Names -> T_Names +sem_Names_Cons arg_hd_ arg_tl_ = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _hdX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_hd_)) + _tlX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_tl_)) + (T_Name_vOut112 _hdIself) = inv_Name_s113 _hdX113 (T_Name_vIn112 ) + (T_Names_vOut115 _tlIself) = inv_Names_s116 _tlX116 (T_Names_vIn115 ) + _self = rule569 _hdIself _tlIself + _lhsOself :: Names + _lhsOself = rule570 _self + __result_ = T_Names_vOut115 _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule569 #-} + rule569 = \ ((_hdIself) :: Name) ((_tlIself) :: Names) -> + (:) _hdIself _tlIself + {-# INLINE rule570 #-} + rule570 = \ _self -> + _self +{-# NOINLINE sem_Names_Nil #-} +sem_Names_Nil :: T_Names +sem_Names_Nil = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _self = rule571 () + _lhsOself :: Names + _lhsOself = rule572 _self + __result_ = T_Names_vOut115 _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule571 #-} + rule571 = \ (_ :: ()) -> + [] + {-# INLINE rule572 #-} + rule572 = \ _self -> + _self + +-- Pattern ----------------------------------------------------- +-- wrapper +data Inh_Pattern = Inh_Pattern { } +data Syn_Pattern = Syn_Pattern { self_Syn_Pattern :: (Pattern) } +{-# INLINABLE wrap_Pattern #-} +wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) +wrap_Pattern (T_Pattern act) (Inh_Pattern ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Pattern_vIn118 + (T_Pattern_vOut118 _lhsOself) <- return (inv_Pattern_s119 sem arg) + return (Syn_Pattern _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Pattern #-} +sem_Pattern :: Pattern -> T_Pattern +sem_Pattern ( Pattern_Hole range_ id_ ) = sem_Pattern_Hole ( sem_Range range_ ) id_ +sem_Pattern ( Pattern_Literal range_ literal_ ) = sem_Pattern_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_Variable range_ name_ ) = sem_Pattern_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Pattern ( Pattern_Constructor range_ name_ patterns_ ) = sem_Pattern_Constructor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Parenthesized range_ pattern_ ) = sem_Pattern_Parenthesized ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ ) = sem_Pattern_InfixConstructor ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name constructorOperator_ ) ( sem_Pattern rightPattern_ ) +sem_Pattern ( Pattern_List range_ patterns_ ) = sem_Pattern_List ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Tuple range_ patterns_ ) = sem_Pattern_Tuple ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Record range_ name_ recordPatternBindings_ ) = sem_Pattern_Record ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordPatternBindings recordPatternBindings_ ) +sem_Pattern ( Pattern_Negate range_ literal_ ) = sem_Pattern_Negate ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_As range_ name_ pattern_ ) = sem_Pattern_As ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Wildcard range_ ) = sem_Pattern_Wildcard ( sem_Range range_ ) +sem_Pattern ( Pattern_Irrefutable range_ pattern_ ) = sem_Pattern_Irrefutable ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Successor range_ name_ literal_ ) = sem_Pattern_Successor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_NegateFloat range_ literal_ ) = sem_Pattern_NegateFloat ( sem_Range range_ ) ( sem_Literal literal_ ) + +-- semantic domain +newtype T_Pattern = T_Pattern { + attach_T_Pattern :: Identity (T_Pattern_s119 ) + } +newtype T_Pattern_s119 = C_Pattern_s119 { + inv_Pattern_s119 :: (T_Pattern_v118 ) + } +data T_Pattern_s120 = C_Pattern_s120 +type T_Pattern_v118 = (T_Pattern_vIn118 ) -> (T_Pattern_vOut118 ) +data T_Pattern_vIn118 = T_Pattern_vIn118 +data T_Pattern_vOut118 = T_Pattern_vOut118 (Pattern) +{-# NOINLINE sem_Pattern_Hole #-} +sem_Pattern_Hole :: T_Range -> (Integer) -> T_Pattern +sem_Pattern_Hole arg_range_ arg_id_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule573 _rangeIself arg_id_ + _lhsOself :: Pattern + _lhsOself = rule574 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule573 #-} + rule573 = \ ((_rangeIself) :: Range) id_ -> + Pattern_Hole _rangeIself id_ + {-# INLINE rule574 #-} + rule574 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Literal #-} +sem_Pattern_Literal :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Literal arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule575 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule576 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule575 #-} + rule575 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Literal _rangeIself _literalIself + {-# INLINE rule576 #-} + rule576 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Variable #-} +sem_Pattern_Variable :: T_Range -> T_Name -> T_Pattern +sem_Pattern_Variable arg_range_ arg_name_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule577 _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule578 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule577 #-} + rule577 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Variable _rangeIself _nameIself + {-# INLINE rule578 #-} + rule578 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Constructor #-} +sem_Pattern_Constructor :: T_Range -> T_Name -> T_Patterns -> T_Pattern +sem_Pattern_Constructor arg_range_ arg_name_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _self = rule579 _nameIself _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule580 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule579 #-} + rule579 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Constructor _rangeIself _nameIself _patternsIself + {-# INLINE rule580 #-} + rule580 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Parenthesized #-} +sem_Pattern_Parenthesized :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Parenthesized arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _self = rule581 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule582 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule581 #-} + rule581 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Parenthesized _rangeIself _patternIself + {-# INLINE rule582 #-} + rule582 = \ _self -> + _self +{-# NOINLINE sem_Pattern_InfixConstructor #-} +sem_Pattern_InfixConstructor :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_InfixConstructor arg_range_ arg_leftPattern_ arg_constructorOperator_ arg_rightPattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIself) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 ) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIself) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 ) + _self = rule583 _constructorOperatorIself _leftPatternIself _rangeIself _rightPatternIself + _lhsOself :: Pattern + _lhsOself = rule584 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule583 #-} + rule583 = \ ((_constructorOperatorIself) :: Name) ((_leftPatternIself) :: Pattern) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + Pattern_InfixConstructor _rangeIself _leftPatternIself _constructorOperatorIself _rightPatternIself + {-# INLINE rule584 #-} + rule584 = \ _self -> + _self +{-# NOINLINE sem_Pattern_List #-} +sem_Pattern_List :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_List arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _self = rule585 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule586 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule585 #-} + rule585 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_List _rangeIself _patternsIself + {-# INLINE rule586 #-} + rule586 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Tuple #-} +sem_Pattern_Tuple :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_Tuple arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _self = rule587 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule588 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule587 #-} + rule587 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Tuple _rangeIself _patternsIself + {-# INLINE rule588 #-} + rule588 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Record #-} +sem_Pattern_Record :: T_Range -> T_Name -> T_RecordPatternBindings -> T_Pattern +sem_Pattern_Record arg_range_ arg_name_ arg_recordPatternBindings_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordPatternBindingsX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_recordPatternBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordPatternBindings_vOut145 _recordPatternBindingsIself) = inv_RecordPatternBindings_s146 _recordPatternBindingsX146 (T_RecordPatternBindings_vIn145 ) + _self = rule589 _nameIself _rangeIself _recordPatternBindingsIself + _lhsOself :: Pattern + _lhsOself = rule590 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule589 #-} + rule589 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordPatternBindingsIself) :: RecordPatternBindings) -> + Pattern_Record _rangeIself _nameIself _recordPatternBindingsIself + {-# INLINE rule590 #-} + rule590 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Negate #-} +sem_Pattern_Negate :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Negate arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule591 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule592 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule591 #-} + rule591 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Negate _rangeIself _literalIself + {-# INLINE rule592 #-} + rule592 = \ _self -> + _self +{-# NOINLINE sem_Pattern_As #-} +sem_Pattern_As :: T_Range -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_As arg_range_ arg_name_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _self = rule593 _nameIself _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule594 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule593 #-} + rule593 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_As _rangeIself _nameIself _patternIself + {-# INLINE rule594 #-} + rule594 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Wildcard #-} +sem_Pattern_Wildcard :: T_Range -> T_Pattern +sem_Pattern_Wildcard arg_range_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule595 _rangeIself + _lhsOself :: Pattern + _lhsOself = rule596 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule595 #-} + rule595 = \ ((_rangeIself) :: Range) -> + Pattern_Wildcard _rangeIself + {-# INLINE rule596 #-} + rule596 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Irrefutable #-} +sem_Pattern_Irrefutable :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Irrefutable arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _self = rule597 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule598 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule597 #-} + rule597 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Irrefutable _rangeIself _patternIself + {-# INLINE rule598 #-} + rule598 = \ _self -> + _self +{-# NOINLINE sem_Pattern_Successor #-} +sem_Pattern_Successor :: T_Range -> T_Name -> T_Literal -> T_Pattern +sem_Pattern_Successor arg_range_ arg_name_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule599 _literalIself _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule600 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule599 #-} + rule599 = \ ((_literalIself) :: Literal) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Successor _rangeIself _nameIself _literalIself + {-# INLINE rule600 #-} + rule600 = \ _self -> + _self +{-# NOINLINE sem_Pattern_NegateFloat #-} +sem_Pattern_NegateFloat :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_NegateFloat arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _self = rule601 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule602 _self + __result_ = T_Pattern_vOut118 _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule601 #-} + rule601 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_NegateFloat _rangeIself _literalIself + {-# INLINE rule602 #-} + rule602 = \ _self -> + _self + +-- Patterns ---------------------------------------------------- +-- wrapper +data Inh_Patterns = Inh_Patterns { } +data Syn_Patterns = Syn_Patterns { self_Syn_Patterns :: (Patterns) } +{-# INLINABLE wrap_Patterns #-} +wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) +wrap_Patterns (T_Patterns act) (Inh_Patterns ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Patterns_vIn121 + (T_Patterns_vOut121 _lhsOself) <- return (inv_Patterns_s122 sem arg) + return (Syn_Patterns _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Patterns #-} +sem_Patterns :: Patterns -> T_Patterns +sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) + +-- semantic domain +newtype T_Patterns = T_Patterns { + attach_T_Patterns :: Identity (T_Patterns_s122 ) + } +newtype T_Patterns_s122 = C_Patterns_s122 { + inv_Patterns_s122 :: (T_Patterns_v121 ) + } +data T_Patterns_s123 = C_Patterns_s123 +type T_Patterns_v121 = (T_Patterns_vIn121 ) -> (T_Patterns_vOut121 ) +data T_Patterns_vIn121 = T_Patterns_vIn121 +data T_Patterns_vOut121 = T_Patterns_vOut121 (Patterns) +{-# NOINLINE sem_Patterns_Cons #-} +sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns +sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 ) -> ( let + _hdX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) + _tlX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) + (T_Pattern_vOut118 _hdIself) = inv_Pattern_s119 _hdX119 (T_Pattern_vIn118 ) + (T_Patterns_vOut121 _tlIself) = inv_Patterns_s122 _tlX122 (T_Patterns_vIn121 ) + _self = rule603 _hdIself _tlIself + _lhsOself :: Patterns + _lhsOself = rule604 _self + __result_ = T_Patterns_vOut121 _lhsOself + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule603 #-} + rule603 = \ ((_hdIself) :: Pattern) ((_tlIself) :: Patterns) -> + (:) _hdIself _tlIself + {-# INLINE rule604 #-} + rule604 = \ _self -> + _self +{-# NOINLINE sem_Patterns_Nil #-} +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 ) -> ( let + _self = rule605 () + _lhsOself :: Patterns + _lhsOself = rule606 _self + __result_ = T_Patterns_vOut121 _lhsOself + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule605 #-} + rule605 = \ (_ :: ()) -> + [] + {-# INLINE rule606 #-} + rule606 = \ _self -> + _self + +-- Position ---------------------------------------------------- +-- wrapper +data Inh_Position = Inh_Position { } +data Syn_Position = Syn_Position { self_Syn_Position :: (Position) } +{-# INLINABLE wrap_Position #-} +wrap_Position :: T_Position -> Inh_Position -> (Syn_Position ) +wrap_Position (T_Position act) (Inh_Position ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Position_vIn124 + (T_Position_vOut124 _lhsOself) <- return (inv_Position_s125 sem arg) + return (Syn_Position _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Position #-} +sem_Position :: Position -> T_Position +sem_Position ( Position_Position filename_ line_ column_ ) = sem_Position_Position filename_ line_ column_ +sem_Position ( Position_Unknown ) = sem_Position_Unknown + +-- semantic domain +newtype T_Position = T_Position { + attach_T_Position :: Identity (T_Position_s125 ) + } +newtype T_Position_s125 = C_Position_s125 { + inv_Position_s125 :: (T_Position_v124 ) + } +data T_Position_s126 = C_Position_s126 +type T_Position_v124 = (T_Position_vIn124 ) -> (T_Position_vOut124 ) +data T_Position_vIn124 = T_Position_vIn124 +data T_Position_vOut124 = T_Position_vOut124 (Position) +{-# NOINLINE sem_Position_Position #-} +sem_Position_Position :: (String) -> (Int) -> (Int) -> T_Position +sem_Position_Position arg_filename_ arg_line_ arg_column_ = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule607 arg_column_ arg_filename_ arg_line_ + _lhsOself :: Position + _lhsOself = rule608 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule607 #-} + rule607 = \ column_ filename_ line_ -> + Position_Position filename_ line_ column_ + {-# INLINE rule608 #-} + rule608 = \ _self -> + _self +{-# NOINLINE sem_Position_Unknown #-} +sem_Position_Unknown :: T_Position +sem_Position_Unknown = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule609 () + _lhsOself :: Position + _lhsOself = rule610 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule609 #-} + rule609 = \ (_ :: ()) -> + Position_Unknown + {-# INLINE rule610 #-} + rule610 = \ _self -> + _self + +-- Qualifier --------------------------------------------------- +-- wrapper +data Inh_Qualifier = Inh_Qualifier { bindingGroups_Inh_Qualifier :: (BindingGroups), kappaUnique_Inh_Qualifier :: (Int) } +data Syn_Qualifier = Syn_Qualifier { bindingGroups_Syn_Qualifier :: (BindingGroups), kappaUnique_Syn_Qualifier :: (Int), self_Syn_Qualifier :: (Qualifier) } +{-# INLINABLE wrap_Qualifier #-} +wrap_Qualifier :: T_Qualifier -> Inh_Qualifier -> (Syn_Qualifier ) +wrap_Qualifier (T_Qualifier act) (Inh_Qualifier _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifier_vIn127 _lhsIbindingGroups _lhsIkappaUnique + (T_Qualifier_vOut127 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_Qualifier_s128 sem arg) + return (Syn_Qualifier _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifier #-} +sem_Qualifier :: Qualifier -> T_Qualifier +sem_Qualifier ( Qualifier_Guard range_ guard_ ) = sem_Qualifier_Guard ( sem_Range range_ ) ( sem_Expression guard_ ) +sem_Qualifier ( Qualifier_Let range_ declarations_ ) = sem_Qualifier_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Qualifier ( Qualifier_Generator range_ pattern_ expression_ ) = sem_Qualifier_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Qualifier ( Qualifier_Empty range_ ) = sem_Qualifier_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Qualifier = T_Qualifier { + attach_T_Qualifier :: Identity (T_Qualifier_s128 ) + } +newtype T_Qualifier_s128 = C_Qualifier_s128 { + inv_Qualifier_s128 :: (T_Qualifier_v127 ) + } +data T_Qualifier_s129 = C_Qualifier_s129 +type T_Qualifier_v127 = (T_Qualifier_vIn127 ) -> (T_Qualifier_vOut127 ) +data T_Qualifier_vIn127 = T_Qualifier_vIn127 (BindingGroups) (Int) +data T_Qualifier_vOut127 = T_Qualifier_vOut127 (BindingGroups) (Int) (Qualifier) +{-# NOINLINE sem_Qualifier_Guard #-} +sem_Qualifier_Guard :: T_Range -> T_Expression -> T_Qualifier +sem_Qualifier_Guard arg_range_ arg_guard_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIbindingGroups _guardIkappaUnique _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 _guardObindingGroups _guardOkappaUnique) + _self = rule611 _guardIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule612 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule613 _guardIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule614 _guardIkappaUnique + _guardObindingGroups = rule615 _lhsIbindingGroups + _guardOkappaUnique = rule616 _lhsIkappaUnique + __result_ = T_Qualifier_vOut127 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule611 #-} + rule611 = \ ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + Qualifier_Guard _rangeIself _guardIself + {-# INLINE rule612 #-} + rule612 = \ _self -> + _self + {-# INLINE rule613 #-} + rule613 = \ ((_guardIbindingGroups) :: BindingGroups) -> + _guardIbindingGroups + {-# INLINE rule614 #-} + rule614 = \ ((_guardIkappaUnique) :: Int) -> + _guardIkappaUnique + {-# INLINE rule615 #-} + rule615 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule616 #-} + rule616 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Qualifier_Let #-} +sem_Qualifier_Let :: T_Range -> T_Declarations -> T_Qualifier +sem_Qualifier_Let arg_range_ arg_declarations_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIbindingGroups _declarationsIkappaUnique _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsObindingGroups _declarationsOkappaUnique) + _self = rule617 _declarationsIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule618 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule619 _declarationsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule620 _declarationsIkappaUnique + _declarationsObindingGroups = rule621 _lhsIbindingGroups + _declarationsOkappaUnique = rule622 _lhsIkappaUnique + __result_ = T_Qualifier_vOut127 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule617 #-} + rule617 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Qualifier_Let _rangeIself _declarationsIself + {-# INLINE rule618 #-} + rule618 = \ _self -> + _self + {-# INLINE rule619 #-} + rule619 = \ ((_declarationsIbindingGroups) :: BindingGroups) -> + _declarationsIbindingGroups + {-# INLINE rule620 #-} + rule620 = \ ((_declarationsIkappaUnique) :: Int) -> + _declarationsIkappaUnique + {-# INLINE rule621 #-} + rule621 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule622 #-} + rule622 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Qualifier_Generator #-} +sem_Qualifier_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Qualifier +sem_Qualifier_Generator arg_range_ arg_pattern_ arg_expression_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule623 _expressionIself _patternIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule624 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule625 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule626 _expressionIkappaUnique + _expressionObindingGroups = rule627 _lhsIbindingGroups + _expressionOkappaUnique = rule628 _lhsIkappaUnique + __result_ = T_Qualifier_vOut127 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule623 #-} + rule623 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Qualifier_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule624 #-} + rule624 = \ _self -> + _self + {-# INLINE rule625 #-} + rule625 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule626 #-} + rule626 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule627 #-} + rule627 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule628 #-} + rule628 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Qualifier_Empty #-} +sem_Qualifier_Empty :: T_Range -> T_Qualifier +sem_Qualifier_Empty arg_range_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule629 _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule630 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule631 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule632 _lhsIkappaUnique + __result_ = T_Qualifier_vOut127 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule629 #-} + rule629 = \ ((_rangeIself) :: Range) -> + Qualifier_Empty _rangeIself + {-# INLINE rule630 #-} + rule630 = \ _self -> + _self + {-# INLINE rule631 #-} + rule631 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule632 #-} + rule632 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Qualifiers -------------------------------------------------- +-- wrapper +data Inh_Qualifiers = Inh_Qualifiers { bindingGroups_Inh_Qualifiers :: (BindingGroups), kappaUnique_Inh_Qualifiers :: (Int) } +data Syn_Qualifiers = Syn_Qualifiers { bindingGroups_Syn_Qualifiers :: (BindingGroups), kappaUnique_Syn_Qualifiers :: (Int), self_Syn_Qualifiers :: (Qualifiers) } +{-# INLINABLE wrap_Qualifiers #-} +wrap_Qualifiers :: T_Qualifiers -> Inh_Qualifiers -> (Syn_Qualifiers ) +wrap_Qualifiers (T_Qualifiers act) (Inh_Qualifiers _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifiers_vIn130 _lhsIbindingGroups _lhsIkappaUnique + (T_Qualifiers_vOut130 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_Qualifiers_s131 sem arg) + return (Syn_Qualifiers _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifiers #-} +sem_Qualifiers :: Qualifiers -> T_Qualifiers +sem_Qualifiers list = Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list) + +-- semantic domain +newtype T_Qualifiers = T_Qualifiers { + attach_T_Qualifiers :: Identity (T_Qualifiers_s131 ) + } +newtype T_Qualifiers_s131 = C_Qualifiers_s131 { + inv_Qualifiers_s131 :: (T_Qualifiers_v130 ) + } +data T_Qualifiers_s132 = C_Qualifiers_s132 +type T_Qualifiers_v130 = (T_Qualifiers_vIn130 ) -> (T_Qualifiers_vOut130 ) +data T_Qualifiers_vIn130 = T_Qualifiers_vIn130 (BindingGroups) (Int) +data T_Qualifiers_vOut130 = T_Qualifiers_vOut130 (BindingGroups) (Int) (Qualifiers) +{-# NOINLINE sem_Qualifiers_Cons #-} +sem_Qualifiers_Cons :: T_Qualifier -> T_Qualifiers -> T_Qualifiers +sem_Qualifiers_Cons arg_hd_ arg_tl_ = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _hdX128 = Control.Monad.Identity.runIdentity (attach_T_Qualifier (arg_hd_)) + _tlX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_tl_)) + (T_Qualifier_vOut127 _hdIbindingGroups _hdIkappaUnique _hdIself) = inv_Qualifier_s128 _hdX128 (T_Qualifier_vIn127 _hdObindingGroups _hdOkappaUnique) + (T_Qualifiers_vOut130 _tlIbindingGroups _tlIkappaUnique _tlIself) = inv_Qualifiers_s131 _tlX131 (T_Qualifiers_vIn130 _tlObindingGroups _tlOkappaUnique) + _self = rule633 _hdIself _tlIself + _lhsOself :: Qualifiers + _lhsOself = rule634 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule635 _tlIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule636 _tlIkappaUnique + _hdObindingGroups = rule637 _lhsIbindingGroups + _hdOkappaUnique = rule638 _lhsIkappaUnique + _tlObindingGroups = rule639 _hdIbindingGroups + _tlOkappaUnique = rule640 _hdIkappaUnique + __result_ = T_Qualifiers_vOut130 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule633 #-} + rule633 = \ ((_hdIself) :: Qualifier) ((_tlIself) :: Qualifiers) -> + (:) _hdIself _tlIself + {-# INLINE rule634 #-} + rule634 = \ _self -> + _self + {-# INLINE rule635 #-} + rule635 = \ ((_tlIbindingGroups) :: BindingGroups) -> + _tlIbindingGroups + {-# INLINE rule636 #-} + rule636 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule637 #-} + rule637 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule638 #-} + rule638 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule639 #-} + rule639 = \ ((_hdIbindingGroups) :: BindingGroups) -> + _hdIbindingGroups + {-# INLINE rule640 #-} + rule640 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_Qualifiers_Nil #-} +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _self = rule641 () + _lhsOself :: Qualifiers + _lhsOself = rule642 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule643 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule644 _lhsIkappaUnique + __result_ = T_Qualifiers_vOut130 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule641 #-} + rule641 = \ (_ :: ()) -> + [] + {-# INLINE rule642 #-} + rule642 = \ _self -> + _self + {-# INLINE rule643 #-} + rule643 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule644 #-} + rule644 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Range ------------------------------------------------------- +-- wrapper +data Inh_Range = Inh_Range { } +data Syn_Range = Syn_Range { self_Syn_Range :: (Range) } +{-# INLINABLE wrap_Range #-} +wrap_Range :: T_Range -> Inh_Range -> (Syn_Range ) +wrap_Range (T_Range act) (Inh_Range ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Range_vIn133 + (T_Range_vOut133 _lhsOself) <- return (inv_Range_s134 sem arg) + return (Syn_Range _lhsOself) + ) + +-- cata +{-# INLINE sem_Range #-} +sem_Range :: Range -> T_Range +sem_Range ( Range_Range start_ stop_ ) = sem_Range_Range ( sem_Position start_ ) ( sem_Position stop_ ) + +-- semantic domain +newtype T_Range = T_Range { + attach_T_Range :: Identity (T_Range_s134 ) + } +newtype T_Range_s134 = C_Range_s134 { + inv_Range_s134 :: (T_Range_v133 ) + } +data T_Range_s135 = C_Range_s135 +type T_Range_v133 = (T_Range_vIn133 ) -> (T_Range_vOut133 ) +data T_Range_vIn133 = T_Range_vIn133 +data T_Range_vOut133 = T_Range_vOut133 (Range) +{-# NOINLINE sem_Range_Range #-} +sem_Range_Range :: T_Position -> T_Position -> T_Range +sem_Range_Range arg_start_ arg_stop_ = T_Range (return st134) where + {-# NOINLINE st134 #-} + st134 = let + v133 :: T_Range_v133 + v133 = \ (T_Range_vIn133 ) -> ( let + _startX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_start_)) + _stopX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_stop_)) + (T_Position_vOut124 _startIself) = inv_Position_s125 _startX125 (T_Position_vIn124 ) + (T_Position_vOut124 _stopIself) = inv_Position_s125 _stopX125 (T_Position_vIn124 ) + _self = rule645 _startIself _stopIself + _lhsOself :: Range + _lhsOself = rule646 _self + __result_ = T_Range_vOut133 _lhsOself + in __result_ ) + in C_Range_s134 v133 + {-# INLINE rule645 #-} + rule645 = \ ((_startIself) :: Position) ((_stopIself) :: Position) -> + Range_Range _startIself _stopIself + {-# INLINE rule646 #-} + rule646 = \ _self -> + _self + +-- RecordExpressionBinding ------------------------------------- +-- wrapper +data Inh_RecordExpressionBinding = Inh_RecordExpressionBinding { bindingGroups_Inh_RecordExpressionBinding :: (BindingGroups), kappaUnique_Inh_RecordExpressionBinding :: (Int) } +data Syn_RecordExpressionBinding = Syn_RecordExpressionBinding { bindingGroups_Syn_RecordExpressionBinding :: (BindingGroups), kappaUnique_Syn_RecordExpressionBinding :: (Int), self_Syn_RecordExpressionBinding :: (RecordExpressionBinding) } +{-# INLINABLE wrap_RecordExpressionBinding #-} +wrap_RecordExpressionBinding :: T_RecordExpressionBinding -> Inh_RecordExpressionBinding -> (Syn_RecordExpressionBinding ) +wrap_RecordExpressionBinding (T_RecordExpressionBinding act) (Inh_RecordExpressionBinding _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBinding_vIn136 _lhsIbindingGroups _lhsIkappaUnique + (T_RecordExpressionBinding_vOut136 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_RecordExpressionBinding_s137 sem arg) + return (Syn_RecordExpressionBinding _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBinding #-} +sem_RecordExpressionBinding :: RecordExpressionBinding -> T_RecordExpressionBinding +sem_RecordExpressionBinding ( RecordExpressionBinding_RecordExpressionBinding range_ name_ expression_ ) = sem_RecordExpressionBinding_RecordExpressionBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_RecordExpressionBinding = T_RecordExpressionBinding { + attach_T_RecordExpressionBinding :: Identity (T_RecordExpressionBinding_s137 ) + } +newtype T_RecordExpressionBinding_s137 = C_RecordExpressionBinding_s137 { + inv_RecordExpressionBinding_s137 :: (T_RecordExpressionBinding_v136 ) + } +data T_RecordExpressionBinding_s138 = C_RecordExpressionBinding_s138 +type T_RecordExpressionBinding_v136 = (T_RecordExpressionBinding_vIn136 ) -> (T_RecordExpressionBinding_vOut136 ) +data T_RecordExpressionBinding_vIn136 = T_RecordExpressionBinding_vIn136 (BindingGroups) (Int) +data T_RecordExpressionBinding_vOut136 = T_RecordExpressionBinding_vOut136 (BindingGroups) (Int) (RecordExpressionBinding) +{-# NOINLINE sem_RecordExpressionBinding_RecordExpressionBinding #-} +sem_RecordExpressionBinding_RecordExpressionBinding :: T_Range -> T_Name -> T_Expression -> T_RecordExpressionBinding +sem_RecordExpressionBinding_RecordExpressionBinding arg_range_ arg_name_ arg_expression_ = T_RecordExpressionBinding (return st137) where + {-# NOINLINE st137 #-} + st137 = let + v136 :: T_RecordExpressionBinding_v136 + v136 = \ (T_RecordExpressionBinding_vIn136 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule647 _expressionIself _nameIself _rangeIself + _lhsOself :: RecordExpressionBinding + _lhsOself = rule648 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule649 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule650 _expressionIkappaUnique + _expressionObindingGroups = rule651 _lhsIbindingGroups + _expressionOkappaUnique = rule652 _lhsIkappaUnique + __result_ = T_RecordExpressionBinding_vOut136 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_RecordExpressionBinding_s137 v136 + {-# INLINE rule647 #-} + rule647 = \ ((_expressionIself) :: Expression) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + RecordExpressionBinding_RecordExpressionBinding _rangeIself _nameIself _expressionIself + {-# INLINE rule648 #-} + rule648 = \ _self -> + _self + {-# INLINE rule649 #-} + rule649 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule650 #-} + rule650 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule651 #-} + rule651 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule652 #-} + rule652 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- RecordExpressionBindings ------------------------------------ +-- wrapper +data Inh_RecordExpressionBindings = Inh_RecordExpressionBindings { bindingGroups_Inh_RecordExpressionBindings :: (BindingGroups), kappaUnique_Inh_RecordExpressionBindings :: (Int) } +data Syn_RecordExpressionBindings = Syn_RecordExpressionBindings { bindingGroups_Syn_RecordExpressionBindings :: (BindingGroups), kappaUnique_Syn_RecordExpressionBindings :: (Int), self_Syn_RecordExpressionBindings :: (RecordExpressionBindings) } +{-# INLINABLE wrap_RecordExpressionBindings #-} +wrap_RecordExpressionBindings :: T_RecordExpressionBindings -> Inh_RecordExpressionBindings -> (Syn_RecordExpressionBindings ) +wrap_RecordExpressionBindings (T_RecordExpressionBindings act) (Inh_RecordExpressionBindings _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBindings_vIn139 _lhsIbindingGroups _lhsIkappaUnique + (T_RecordExpressionBindings_vOut139 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_RecordExpressionBindings_s140 sem arg) + return (Syn_RecordExpressionBindings _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBindings #-} +sem_RecordExpressionBindings :: RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings list = Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list) + +-- semantic domain +newtype T_RecordExpressionBindings = T_RecordExpressionBindings { + attach_T_RecordExpressionBindings :: Identity (T_RecordExpressionBindings_s140 ) + } +newtype T_RecordExpressionBindings_s140 = C_RecordExpressionBindings_s140 { + inv_RecordExpressionBindings_s140 :: (T_RecordExpressionBindings_v139 ) + } +data T_RecordExpressionBindings_s141 = C_RecordExpressionBindings_s141 +type T_RecordExpressionBindings_v139 = (T_RecordExpressionBindings_vIn139 ) -> (T_RecordExpressionBindings_vOut139 ) +data T_RecordExpressionBindings_vIn139 = T_RecordExpressionBindings_vIn139 (BindingGroups) (Int) +data T_RecordExpressionBindings_vOut139 = T_RecordExpressionBindings_vOut139 (BindingGroups) (Int) (RecordExpressionBindings) +{-# NOINLINE sem_RecordExpressionBindings_Cons #-} +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> T_RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons arg_hd_ arg_tl_ = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _hdX137 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBinding (arg_hd_)) + _tlX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_tl_)) + (T_RecordExpressionBinding_vOut136 _hdIbindingGroups _hdIkappaUnique _hdIself) = inv_RecordExpressionBinding_s137 _hdX137 (T_RecordExpressionBinding_vIn136 _hdObindingGroups _hdOkappaUnique) + (T_RecordExpressionBindings_vOut139 _tlIbindingGroups _tlIkappaUnique _tlIself) = inv_RecordExpressionBindings_s140 _tlX140 (T_RecordExpressionBindings_vIn139 _tlObindingGroups _tlOkappaUnique) + _self = rule653 _hdIself _tlIself + _lhsOself :: RecordExpressionBindings + _lhsOself = rule654 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule655 _tlIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule656 _tlIkappaUnique + _hdObindingGroups = rule657 _lhsIbindingGroups + _hdOkappaUnique = rule658 _lhsIkappaUnique + _tlObindingGroups = rule659 _hdIbindingGroups + _tlOkappaUnique = rule660 _hdIkappaUnique + __result_ = T_RecordExpressionBindings_vOut139 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule653 #-} + rule653 = \ ((_hdIself) :: RecordExpressionBinding) ((_tlIself) :: RecordExpressionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule654 #-} + rule654 = \ _self -> + _self + {-# INLINE rule655 #-} + rule655 = \ ((_tlIbindingGroups) :: BindingGroups) -> + _tlIbindingGroups + {-# INLINE rule656 #-} + rule656 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule657 #-} + rule657 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule658 #-} + rule658 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule659 #-} + rule659 = \ ((_hdIbindingGroups) :: BindingGroups) -> + _hdIbindingGroups + {-# INLINE rule660 #-} + rule660 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_RecordExpressionBindings_Nil #-} +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _self = rule661 () + _lhsOself :: RecordExpressionBindings + _lhsOself = rule662 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule663 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule664 _lhsIkappaUnique + __result_ = T_RecordExpressionBindings_vOut139 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule661 #-} + rule661 = \ (_ :: ()) -> + [] + {-# INLINE rule662 #-} + rule662 = \ _self -> + _self + {-# INLINE rule663 #-} + rule663 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule664 #-} + rule664 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- RecordPatternBinding ---------------------------------------- +-- wrapper +data Inh_RecordPatternBinding = Inh_RecordPatternBinding { } +data Syn_RecordPatternBinding = Syn_RecordPatternBinding { self_Syn_RecordPatternBinding :: (RecordPatternBinding) } +{-# INLINABLE wrap_RecordPatternBinding #-} +wrap_RecordPatternBinding :: T_RecordPatternBinding -> Inh_RecordPatternBinding -> (Syn_RecordPatternBinding ) +wrap_RecordPatternBinding (T_RecordPatternBinding act) (Inh_RecordPatternBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBinding_vIn142 + (T_RecordPatternBinding_vOut142 _lhsOself) <- return (inv_RecordPatternBinding_s143 sem arg) + return (Syn_RecordPatternBinding _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBinding #-} +sem_RecordPatternBinding :: RecordPatternBinding -> T_RecordPatternBinding +sem_RecordPatternBinding ( RecordPatternBinding_RecordPatternBinding range_ name_ pattern_ ) = sem_RecordPatternBinding_RecordPatternBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) + +-- semantic domain +newtype T_RecordPatternBinding = T_RecordPatternBinding { + attach_T_RecordPatternBinding :: Identity (T_RecordPatternBinding_s143 ) + } +newtype T_RecordPatternBinding_s143 = C_RecordPatternBinding_s143 { + inv_RecordPatternBinding_s143 :: (T_RecordPatternBinding_v142 ) + } +data T_RecordPatternBinding_s144 = C_RecordPatternBinding_s144 +type T_RecordPatternBinding_v142 = (T_RecordPatternBinding_vIn142 ) -> (T_RecordPatternBinding_vOut142 ) +data T_RecordPatternBinding_vIn142 = T_RecordPatternBinding_vIn142 +data T_RecordPatternBinding_vOut142 = T_RecordPatternBinding_vOut142 (RecordPatternBinding) +{-# NOINLINE sem_RecordPatternBinding_RecordPatternBinding #-} +sem_RecordPatternBinding_RecordPatternBinding :: T_Range -> T_Name -> T_Pattern -> T_RecordPatternBinding +sem_RecordPatternBinding_RecordPatternBinding arg_range_ arg_name_ arg_pattern_ = T_RecordPatternBinding (return st143) where + {-# NOINLINE st143 #-} + st143 = let + v142 :: T_RecordPatternBinding_v142 + v142 = \ (T_RecordPatternBinding_vIn142 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _self = rule665 _nameIself _patternIself _rangeIself + _lhsOself :: RecordPatternBinding + _lhsOself = rule666 _self + __result_ = T_RecordPatternBinding_vOut142 _lhsOself + in __result_ ) + in C_RecordPatternBinding_s143 v142 + {-# INLINE rule665 #-} + rule665 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + RecordPatternBinding_RecordPatternBinding _rangeIself _nameIself _patternIself + {-# INLINE rule666 #-} + rule666 = \ _self -> + _self + +-- RecordPatternBindings --------------------------------------- +-- wrapper +data Inh_RecordPatternBindings = Inh_RecordPatternBindings { } +data Syn_RecordPatternBindings = Syn_RecordPatternBindings { self_Syn_RecordPatternBindings :: (RecordPatternBindings) } +{-# INLINABLE wrap_RecordPatternBindings #-} +wrap_RecordPatternBindings :: T_RecordPatternBindings -> Inh_RecordPatternBindings -> (Syn_RecordPatternBindings ) +wrap_RecordPatternBindings (T_RecordPatternBindings act) (Inh_RecordPatternBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBindings_vIn145 + (T_RecordPatternBindings_vOut145 _lhsOself) <- return (inv_RecordPatternBindings_s146 sem arg) + return (Syn_RecordPatternBindings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBindings #-} +sem_RecordPatternBindings :: RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings list = Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list) + +-- semantic domain +newtype T_RecordPatternBindings = T_RecordPatternBindings { + attach_T_RecordPatternBindings :: Identity (T_RecordPatternBindings_s146 ) + } +newtype T_RecordPatternBindings_s146 = C_RecordPatternBindings_s146 { + inv_RecordPatternBindings_s146 :: (T_RecordPatternBindings_v145 ) + } +data T_RecordPatternBindings_s147 = C_RecordPatternBindings_s147 +type T_RecordPatternBindings_v145 = (T_RecordPatternBindings_vIn145 ) -> (T_RecordPatternBindings_vOut145 ) +data T_RecordPatternBindings_vIn145 = T_RecordPatternBindings_vIn145 +data T_RecordPatternBindings_vOut145 = T_RecordPatternBindings_vOut145 (RecordPatternBindings) +{-# NOINLINE sem_RecordPatternBindings_Cons #-} +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> T_RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings_Cons arg_hd_ arg_tl_ = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 ) -> ( let + _hdX143 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBinding (arg_hd_)) + _tlX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_tl_)) + (T_RecordPatternBinding_vOut142 _hdIself) = inv_RecordPatternBinding_s143 _hdX143 (T_RecordPatternBinding_vIn142 ) + (T_RecordPatternBindings_vOut145 _tlIself) = inv_RecordPatternBindings_s146 _tlX146 (T_RecordPatternBindings_vIn145 ) + _self = rule667 _hdIself _tlIself + _lhsOself :: RecordPatternBindings + _lhsOself = rule668 _self + __result_ = T_RecordPatternBindings_vOut145 _lhsOself + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule667 #-} + rule667 = \ ((_hdIself) :: RecordPatternBinding) ((_tlIself) :: RecordPatternBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule668 #-} + rule668 = \ _self -> + _self +{-# NOINLINE sem_RecordPatternBindings_Nil #-} +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 ) -> ( let + _self = rule669 () + _lhsOself :: RecordPatternBindings + _lhsOself = rule670 _self + __result_ = T_RecordPatternBindings_vOut145 _lhsOself + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule669 #-} + rule669 = \ (_ :: ()) -> + [] + {-# INLINE rule670 #-} + rule670 = \ _self -> + _self + +-- RightHandSide ----------------------------------------------- +-- wrapper +data Inh_RightHandSide = Inh_RightHandSide { bindingGroups_Inh_RightHandSide :: (BindingGroups), kappaUnique_Inh_RightHandSide :: (Int) } +data Syn_RightHandSide = Syn_RightHandSide { bindingGroups_Syn_RightHandSide :: (BindingGroups), kappaUnique_Syn_RightHandSide :: (Int), self_Syn_RightHandSide :: (RightHandSide) } +{-# INLINABLE wrap_RightHandSide #-} +wrap_RightHandSide :: T_RightHandSide -> Inh_RightHandSide -> (Syn_RightHandSide ) +wrap_RightHandSide (T_RightHandSide act) (Inh_RightHandSide _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RightHandSide_vIn148 _lhsIbindingGroups _lhsIkappaUnique + (T_RightHandSide_vOut148 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_RightHandSide_s149 sem arg) + return (Syn_RightHandSide _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RightHandSide #-} +sem_RightHandSide :: RightHandSide -> T_RightHandSide +sem_RightHandSide ( RightHandSide_Expression range_ expression_ where_ ) = sem_RightHandSide_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_MaybeDeclarations where_ ) +sem_RightHandSide ( RightHandSide_Guarded range_ guardedexpressions_ where_ ) = sem_RightHandSide_Guarded ( sem_Range range_ ) ( sem_GuardedExpressions guardedexpressions_ ) ( sem_MaybeDeclarations where_ ) + +-- semantic domain +newtype T_RightHandSide = T_RightHandSide { + attach_T_RightHandSide :: Identity (T_RightHandSide_s149 ) + } +newtype T_RightHandSide_s149 = C_RightHandSide_s149 { + inv_RightHandSide_s149 :: (T_RightHandSide_v148 ) + } +data T_RightHandSide_s150 = C_RightHandSide_s150 +type T_RightHandSide_v148 = (T_RightHandSide_vIn148 ) -> (T_RightHandSide_vOut148 ) +data T_RightHandSide_vIn148 = T_RightHandSide_vIn148 (BindingGroups) (Int) +data T_RightHandSide_vOut148 = T_RightHandSide_vOut148 (BindingGroups) (Int) (RightHandSide) +{-# NOINLINE sem_RightHandSide_Expression #-} +sem_RightHandSide_Expression :: T_Range -> T_Expression -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Expression arg_range_ arg_expression_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + (T_MaybeDeclarations_vOut88 _whereIbindingGroups _whereIkappaUnique _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereObindingGroups _whereOkappaUnique) + _self = rule671 _expressionIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule672 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule673 _whereIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule674 _whereIkappaUnique + _expressionObindingGroups = rule675 _lhsIbindingGroups + _expressionOkappaUnique = rule676 _lhsIkappaUnique + _whereObindingGroups = rule677 _expressionIbindingGroups + _whereOkappaUnique = rule678 _expressionIkappaUnique + __result_ = T_RightHandSide_vOut148 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule671 #-} + rule671 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Expression _rangeIself _expressionIself _whereIself + {-# INLINE rule672 #-} + rule672 = \ _self -> + _self + {-# INLINE rule673 #-} + rule673 = \ ((_whereIbindingGroups) :: BindingGroups) -> + _whereIbindingGroups + {-# INLINE rule674 #-} + rule674 = \ ((_whereIkappaUnique) :: Int) -> + _whereIkappaUnique + {-# INLINE rule675 #-} + rule675 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule676 #-} + rule676 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule677 #-} + rule677 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule678 #-} + rule678 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique +{-# NOINLINE sem_RightHandSide_Guarded #-} +sem_RightHandSide_Guarded :: T_Range -> T_GuardedExpressions -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Guarded arg_range_ arg_guardedexpressions_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardedexpressionsX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_guardedexpressions_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_GuardedExpressions_vOut64 _guardedexpressionsIbindingGroups _guardedexpressionsIkappaUnique _guardedexpressionsIself) = inv_GuardedExpressions_s65 _guardedexpressionsX65 (T_GuardedExpressions_vIn64 _guardedexpressionsObindingGroups _guardedexpressionsOkappaUnique) + (T_MaybeDeclarations_vOut88 _whereIbindingGroups _whereIkappaUnique _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereObindingGroups _whereOkappaUnique) + _self = rule679 _guardedexpressionsIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule680 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule681 _whereIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule682 _whereIkappaUnique + _guardedexpressionsObindingGroups = rule683 _lhsIbindingGroups + _guardedexpressionsOkappaUnique = rule684 _lhsIkappaUnique + _whereObindingGroups = rule685 _guardedexpressionsIbindingGroups + _whereOkappaUnique = rule686 _guardedexpressionsIkappaUnique + __result_ = T_RightHandSide_vOut148 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule679 #-} + rule679 = \ ((_guardedexpressionsIself) :: GuardedExpressions) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Guarded _rangeIself _guardedexpressionsIself _whereIself + {-# INLINE rule680 #-} + rule680 = \ _self -> + _self + {-# INLINE rule681 #-} + rule681 = \ ((_whereIbindingGroups) :: BindingGroups) -> + _whereIbindingGroups + {-# INLINE rule682 #-} + rule682 = \ ((_whereIkappaUnique) :: Int) -> + _whereIkappaUnique + {-# INLINE rule683 #-} + rule683 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule684 #-} + rule684 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule685 #-} + rule685 = \ ((_guardedexpressionsIbindingGroups) :: BindingGroups) -> + _guardedexpressionsIbindingGroups + {-# INLINE rule686 #-} + rule686 = \ ((_guardedexpressionsIkappaUnique) :: Int) -> + _guardedexpressionsIkappaUnique + +-- SimpleType -------------------------------------------------- +-- wrapper +data Inh_SimpleType = Inh_SimpleType { constraints_Inh_SimpleType :: (KindConstraints), kappaOfRHS_Inh_SimpleType :: (Kind), kappaUnique_Inh_SimpleType :: (Int) } +data Syn_SimpleType = Syn_SimpleType { constraints_Syn_SimpleType :: (KindConstraints), declared_Syn_SimpleType :: (PatternAssumptions), environment_Syn_SimpleType :: (PatternAssumptions), kappaUnique_Syn_SimpleType :: (Int), self_Syn_SimpleType :: (SimpleType) } +{-# INLINABLE wrap_SimpleType #-} +wrap_SimpleType :: T_SimpleType -> Inh_SimpleType -> (Syn_SimpleType ) +wrap_SimpleType (T_SimpleType act) (Inh_SimpleType _lhsIconstraints _lhsIkappaOfRHS _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_SimpleType_vIn151 _lhsIconstraints _lhsIkappaOfRHS _lhsIkappaUnique + (T_SimpleType_vOut151 _lhsOconstraints _lhsOdeclared _lhsOenvironment _lhsOkappaUnique _lhsOself) <- return (inv_SimpleType_s152 sem arg) + return (Syn_SimpleType _lhsOconstraints _lhsOdeclared _lhsOenvironment _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# INLINE sem_SimpleType #-} +sem_SimpleType :: SimpleType -> T_SimpleType +sem_SimpleType ( SimpleType_SimpleType range_ name_ typevariables_ ) = sem_SimpleType_SimpleType ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Names typevariables_ ) + +-- semantic domain +newtype T_SimpleType = T_SimpleType { + attach_T_SimpleType :: Identity (T_SimpleType_s152 ) + } +newtype T_SimpleType_s152 = C_SimpleType_s152 { + inv_SimpleType_s152 :: (T_SimpleType_v151 ) + } +data T_SimpleType_s153 = C_SimpleType_s153 +type T_SimpleType_v151 = (T_SimpleType_vIn151 ) -> (T_SimpleType_vOut151 ) +data T_SimpleType_vIn151 = T_SimpleType_vIn151 (KindConstraints) (Kind) (Int) +data T_SimpleType_vOut151 = T_SimpleType_vOut151 (KindConstraints) (PatternAssumptions) (PatternAssumptions) (Int) (SimpleType) +{-# NOINLINE sem_SimpleType_SimpleType #-} +sem_SimpleType_SimpleType :: T_Range -> T_Name -> T_Names -> T_SimpleType +sem_SimpleType_SimpleType arg_range_ arg_name_ arg_typevariables_ = T_SimpleType (return st152) where + {-# NOINLINE st152 #-} + st152 = let + v151 :: T_SimpleType_v151 + v151 = \ (T_SimpleType_vIn151 _lhsIconstraints _lhsIkappaOfRHS _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule687 _kappasVars _typevariablesIself + _lhsOdeclared :: PatternAssumptions + _lhsOdeclared = rule688 _kappaCon _nameIself + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule689 _lhsIconstraints _newConstraint + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule690 _lhsIkappaUnique _typevariablesIself + _kappaCon = rule691 _lhsIkappaUnique + _kappasVars = rule692 _lhsIkappaUnique _typevariablesIself + _newConstraint = rule693 _kappaCon _kappasVars _lhsIkappaOfRHS + _self = rule694 _nameIself _rangeIself _typevariablesIself + _lhsOself :: SimpleType + _lhsOself = rule695 _self + __result_ = T_SimpleType_vOut151 _lhsOconstraints _lhsOdeclared _lhsOenvironment _lhsOkappaUnique _lhsOself + in __result_ ) + in C_SimpleType_s152 v151 + {-# INLINE rule687 #-} + rule687 = \ _kappasVars ((_typevariablesIself) :: Names) -> + M.fromList (zip _typevariablesIself _kappasVars) + {-# INLINE rule688 #-} + rule688 = \ _kappaCon ((_nameIself) :: Name) -> + M.singleton _nameIself _kappaCon + {-# INLINE rule689 #-} + rule689 = \ ((_lhsIconstraints) :: KindConstraints) _newConstraint -> + _newConstraint : _lhsIconstraints + {-# INLINE rule690 #-} + rule690 = \ ((_lhsIkappaUnique) :: Int) ((_typevariablesIself) :: Names) -> + 1 + length _typevariablesIself + _lhsIkappaUnique + {-# INLINE rule691 #-} + rule691 = \ ((_lhsIkappaUnique) :: Int) -> + TVar _lhsIkappaUnique + {-# INLINE rule692 #-} + rule692 = \ ((_lhsIkappaUnique) :: Int) ((_typevariablesIself) :: Names) -> + take (length _typevariablesIself) [ TVar i | i <- [ _lhsIkappaUnique+1 .. ]] + {-# INLINE rule693 #-} + rule693 = \ _kappaCon _kappasVars ((_lhsIkappaOfRHS) :: Kind) -> + (_kappaCon .==. foldr (.->.) _lhsIkappaOfRHS _kappasVars) (unexpected "SimpleType.SimpleType") + {-# INLINE rule694 #-} + rule694 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typevariablesIself) :: Names) -> + SimpleType_SimpleType _rangeIself _nameIself _typevariablesIself + {-# INLINE rule695 #-} + rule695 = \ _self -> + _self + +-- Statement --------------------------------------------------- +-- wrapper +data Inh_Statement = Inh_Statement { bindingGroups_Inh_Statement :: (BindingGroups), kappaUnique_Inh_Statement :: (Int) } +data Syn_Statement = Syn_Statement { bindingGroups_Syn_Statement :: (BindingGroups), kappaUnique_Syn_Statement :: (Int), self_Syn_Statement :: (Statement) } +{-# INLINABLE wrap_Statement #-} +wrap_Statement :: T_Statement -> Inh_Statement -> (Syn_Statement ) +wrap_Statement (T_Statement act) (Inh_Statement _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statement_vIn154 _lhsIbindingGroups _lhsIkappaUnique + (T_Statement_vOut154 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_Statement_s155 sem arg) + return (Syn_Statement _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statement #-} +sem_Statement :: Statement -> T_Statement +sem_Statement ( Statement_Expression range_ expression_ ) = sem_Statement_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Let range_ declarations_ ) = sem_Statement_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Statement ( Statement_Generator range_ pattern_ expression_ ) = sem_Statement_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Empty range_ ) = sem_Statement_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Statement = T_Statement { + attach_T_Statement :: Identity (T_Statement_s155 ) + } +newtype T_Statement_s155 = C_Statement_s155 { + inv_Statement_s155 :: (T_Statement_v154 ) + } +data T_Statement_s156 = C_Statement_s156 +type T_Statement_v154 = (T_Statement_vIn154 ) -> (T_Statement_vOut154 ) +data T_Statement_vIn154 = T_Statement_vIn154 (BindingGroups) (Int) +data T_Statement_vOut154 = T_Statement_vOut154 (BindingGroups) (Int) (Statement) +{-# NOINLINE sem_Statement_Expression #-} +sem_Statement_Expression :: T_Range -> T_Expression -> T_Statement +sem_Statement_Expression arg_range_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule696 _expressionIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule697 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule698 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule699 _expressionIkappaUnique + _expressionObindingGroups = rule700 _lhsIbindingGroups + _expressionOkappaUnique = rule701 _lhsIkappaUnique + __result_ = T_Statement_vOut154 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule696 #-} + rule696 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Statement_Expression _rangeIself _expressionIself + {-# INLINE rule697 #-} + rule697 = \ _self -> + _self + {-# INLINE rule698 #-} + rule698 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule699 #-} + rule699 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule700 #-} + rule700 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule701 #-} + rule701 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Statement_Let #-} +sem_Statement_Let :: T_Range -> T_Declarations -> T_Statement +sem_Statement_Let arg_range_ arg_declarations_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIbindingGroups _declarationsIkappaUnique _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsObindingGroups _declarationsOkappaUnique) + _self = rule702 _declarationsIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule703 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule704 _declarationsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule705 _declarationsIkappaUnique + _declarationsObindingGroups = rule706 _lhsIbindingGroups + _declarationsOkappaUnique = rule707 _lhsIkappaUnique + __result_ = T_Statement_vOut154 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule702 #-} + rule702 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Statement_Let _rangeIself _declarationsIself + {-# INLINE rule703 #-} + rule703 = \ _self -> + _self + {-# INLINE rule704 #-} + rule704 = \ ((_declarationsIbindingGroups) :: BindingGroups) -> + _declarationsIbindingGroups + {-# INLINE rule705 #-} + rule705 = \ ((_declarationsIkappaUnique) :: Int) -> + _declarationsIkappaUnique + {-# INLINE rule706 #-} + rule706 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule707 #-} + rule707 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Statement_Generator #-} +sem_Statement_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Statement +sem_Statement_Generator arg_range_ arg_pattern_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_Expression_vOut40 _expressionIbindingGroups _expressionIkappaUnique _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionObindingGroups _expressionOkappaUnique) + _self = rule708 _expressionIself _patternIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule709 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule710 _expressionIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule711 _expressionIkappaUnique + _expressionObindingGroups = rule712 _lhsIbindingGroups + _expressionOkappaUnique = rule713 _lhsIkappaUnique + __result_ = T_Statement_vOut154 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule708 #-} + rule708 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Statement_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule709 #-} + rule709 = \ _self -> + _self + {-# INLINE rule710 #-} + rule710 = \ ((_expressionIbindingGroups) :: BindingGroups) -> + _expressionIbindingGroups + {-# INLINE rule711 #-} + rule711 = \ ((_expressionIkappaUnique) :: Int) -> + _expressionIkappaUnique + {-# INLINE rule712 #-} + rule712 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule713 #-} + rule713 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Statement_Empty #-} +sem_Statement_Empty :: T_Range -> T_Statement +sem_Statement_Empty arg_range_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule714 _rangeIself + _lhsOself :: Statement + _lhsOself = rule715 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule716 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule717 _lhsIkappaUnique + __result_ = T_Statement_vOut154 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule714 #-} + rule714 = \ ((_rangeIself) :: Range) -> + Statement_Empty _rangeIself + {-# INLINE rule715 #-} + rule715 = \ _self -> + _self + {-# INLINE rule716 #-} + rule716 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule717 #-} + rule717 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Statements -------------------------------------------------- +-- wrapper +data Inh_Statements = Inh_Statements { bindingGroups_Inh_Statements :: (BindingGroups), kappaUnique_Inh_Statements :: (Int) } +data Syn_Statements = Syn_Statements { bindingGroups_Syn_Statements :: (BindingGroups), kappaUnique_Syn_Statements :: (Int), self_Syn_Statements :: (Statements) } +{-# INLINABLE wrap_Statements #-} +wrap_Statements :: T_Statements -> Inh_Statements -> (Syn_Statements ) +wrap_Statements (T_Statements act) (Inh_Statements _lhsIbindingGroups _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statements_vIn157 _lhsIbindingGroups _lhsIkappaUnique + (T_Statements_vOut157 _lhsObindingGroups _lhsOkappaUnique _lhsOself) <- return (inv_Statements_s158 sem arg) + return (Syn_Statements _lhsObindingGroups _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statements #-} +sem_Statements :: Statements -> T_Statements +sem_Statements list = Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list) + +-- semantic domain +newtype T_Statements = T_Statements { + attach_T_Statements :: Identity (T_Statements_s158 ) + } +newtype T_Statements_s158 = C_Statements_s158 { + inv_Statements_s158 :: (T_Statements_v157 ) + } +data T_Statements_s159 = C_Statements_s159 +type T_Statements_v157 = (T_Statements_vIn157 ) -> (T_Statements_vOut157 ) +data T_Statements_vIn157 = T_Statements_vIn157 (BindingGroups) (Int) +data T_Statements_vOut157 = T_Statements_vOut157 (BindingGroups) (Int) (Statements) +{-# NOINLINE sem_Statements_Cons #-} +sem_Statements_Cons :: T_Statement -> T_Statements -> T_Statements +sem_Statements_Cons arg_hd_ arg_tl_ = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _hdX155 = Control.Monad.Identity.runIdentity (attach_T_Statement (arg_hd_)) + _tlX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_tl_)) + (T_Statement_vOut154 _hdIbindingGroups _hdIkappaUnique _hdIself) = inv_Statement_s155 _hdX155 (T_Statement_vIn154 _hdObindingGroups _hdOkappaUnique) + (T_Statements_vOut157 _tlIbindingGroups _tlIkappaUnique _tlIself) = inv_Statements_s158 _tlX158 (T_Statements_vIn157 _tlObindingGroups _tlOkappaUnique) + _self = rule718 _hdIself _tlIself + _lhsOself :: Statements + _lhsOself = rule719 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule720 _tlIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule721 _tlIkappaUnique + _hdObindingGroups = rule722 _lhsIbindingGroups + _hdOkappaUnique = rule723 _lhsIkappaUnique + _tlObindingGroups = rule724 _hdIbindingGroups + _tlOkappaUnique = rule725 _hdIkappaUnique + __result_ = T_Statements_vOut157 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule718 #-} + rule718 = \ ((_hdIself) :: Statement) ((_tlIself) :: Statements) -> + (:) _hdIself _tlIself + {-# INLINE rule719 #-} + rule719 = \ _self -> + _self + {-# INLINE rule720 #-} + rule720 = \ ((_tlIbindingGroups) :: BindingGroups) -> + _tlIbindingGroups + {-# INLINE rule721 #-} + rule721 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule722 #-} + rule722 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule723 #-} + rule723 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule724 #-} + rule724 = \ ((_hdIbindingGroups) :: BindingGroups) -> + _hdIbindingGroups + {-# INLINE rule725 #-} + rule725 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_Statements_Nil #-} +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 _lhsIbindingGroups _lhsIkappaUnique) -> ( let + _self = rule726 () + _lhsOself :: Statements + _lhsOself = rule727 _self + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule728 _lhsIbindingGroups + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule729 _lhsIkappaUnique + __result_ = T_Statements_vOut157 _lhsObindingGroups _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule726 #-} + rule726 = \ (_ :: ()) -> + [] + {-# INLINE rule727 #-} + rule727 = \ _self -> + _self + {-# INLINE rule728 #-} + rule728 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule729 #-} + rule729 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Strings ----------------------------------------------------- +-- wrapper +data Inh_Strings = Inh_Strings { } +data Syn_Strings = Syn_Strings { self_Syn_Strings :: (Strings) } +{-# INLINABLE wrap_Strings #-} +wrap_Strings :: T_Strings -> Inh_Strings -> (Syn_Strings ) +wrap_Strings (T_Strings act) (Inh_Strings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Strings_vIn160 + (T_Strings_vOut160 _lhsOself) <- return (inv_Strings_s161 sem arg) + return (Syn_Strings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Strings #-} +sem_Strings :: Strings -> T_Strings +sem_Strings list = Prelude.foldr sem_Strings_Cons sem_Strings_Nil list + +-- semantic domain +newtype T_Strings = T_Strings { + attach_T_Strings :: Identity (T_Strings_s161 ) + } +newtype T_Strings_s161 = C_Strings_s161 { + inv_Strings_s161 :: (T_Strings_v160 ) + } +data T_Strings_s162 = C_Strings_s162 +type T_Strings_v160 = (T_Strings_vIn160 ) -> (T_Strings_vOut160 ) +data T_Strings_vIn160 = T_Strings_vIn160 +data T_Strings_vOut160 = T_Strings_vOut160 (Strings) +{-# NOINLINE sem_Strings_Cons #-} +sem_Strings_Cons :: (String) -> T_Strings -> T_Strings +sem_Strings_Cons arg_hd_ arg_tl_ = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _tlX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_tl_)) + (T_Strings_vOut160 _tlIself) = inv_Strings_s161 _tlX161 (T_Strings_vIn160 ) + _self = rule730 _tlIself arg_hd_ + _lhsOself :: Strings + _lhsOself = rule731 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule730 #-} + rule730 = \ ((_tlIself) :: Strings) hd_ -> + (:) hd_ _tlIself + {-# INLINE rule731 #-} + rule731 = \ _self -> + _self +{-# NOINLINE sem_Strings_Nil #-} +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _self = rule732 () + _lhsOself :: Strings + _lhsOself = rule733 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule732 #-} + rule732 = \ (_ :: ()) -> + [] + {-# INLINE rule733 #-} + rule733 = \ _self -> + _self + +-- Type -------------------------------------------------------- +-- wrapper +data Inh_Type = Inh_Type { constraints_Inh_Type :: (KindConstraints), kappaUnique_Inh_Type :: (Int) } +data Syn_Type = Syn_Type { assumptions_Syn_Type :: (Assumptions), constraints_Syn_Type :: (KindConstraints), kappa_Syn_Type :: (Kind), kappaUnique_Syn_Type :: (Int), self_Syn_Type :: (Type) } +{-# INLINABLE wrap_Type #-} +wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) +wrap_Type (T_Type act) (Inh_Type _lhsIconstraints _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Type_vIn163 _lhsIconstraints _lhsIkappaUnique + (T_Type_vOut163 _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself) <- return (inv_Type_s164 sem arg) + return (Syn_Type _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Type #-} +sem_Type :: Type -> T_Type +sem_Type ( Type_Application range_ prefix_ function_ arguments_ ) = sem_Type_Application ( sem_Range range_ ) prefix_ ( sem_Type function_ ) ( sem_Types arguments_ ) +sem_Type ( Type_Variable range_ name_ ) = sem_Type_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Constructor range_ name_ ) = sem_Type_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Qualified range_ context_ type_ ) = sem_Type_Qualified ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Type type_ ) +sem_Type ( Type_Forall range_ typevariables_ type_ ) = sem_Type_Forall ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Exists range_ typevariables_ type_ ) = sem_Type_Exists ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Parenthesized range_ type_ ) = sem_Type_Parenthesized ( sem_Range range_ ) ( sem_Type type_ ) + +-- semantic domain +newtype T_Type = T_Type { + attach_T_Type :: Identity (T_Type_s164 ) + } +newtype T_Type_s164 = C_Type_s164 { + inv_Type_s164 :: (T_Type_v163 ) + } +data T_Type_s165 = C_Type_s165 +type T_Type_v163 = (T_Type_vIn163 ) -> (T_Type_vOut163 ) +data T_Type_vIn163 = T_Type_vIn163 (KindConstraints) (Int) +data T_Type_vOut163 = T_Type_vOut163 (Assumptions) (KindConstraints) (Kind) (Int) (Type) +{-# NOINLINE sem_Type_Application #-} +sem_Type_Application :: T_Range -> (Bool) -> T_Type -> T_Types -> T_Type +sem_Type_Application arg_range_ arg_prefix_ arg_function_ arg_arguments_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIconstraints _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_function_)) + _argumentsX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _functionIassumptions _functionIconstraints _functionIkappa _functionIkappaUnique _functionIself) = inv_Type_s164 _functionX164 (T_Type_vIn163 _functionOconstraints _functionOkappaUnique) + (T_Types_vOut166 _argumentsIassumptions _argumentsIconstraints _argumentsIkappaUnique _argumentsIkappas _argumentsIself) = inv_Types_s167 _argumentsX167 (T_Types_vIn166 _argumentsOconstraints _argumentsOkappaUnique) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule734 _argumentsIassumptions _functionIassumptions + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule735 _argumentsIconstraints _newConstraint + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule736 _argumentsIkappaUnique + _kappa = rule737 _argumentsIkappaUnique + _newConstraint = rule738 _argumentsIkappas _functionIkappa _functionIself _kappa _rangeIself _self + _self = rule739 _argumentsIself _functionIself _rangeIself arg_prefix_ + _lhsOself :: Type + _lhsOself = rule740 _self + _lhsOkappa :: Kind + _lhsOkappa = rule741 _kappa + _functionOconstraints = rule742 _lhsIconstraints + _functionOkappaUnique = rule743 _lhsIkappaUnique + _argumentsOconstraints = rule744 _functionIconstraints + _argumentsOkappaUnique = rule745 _functionIkappaUnique + __result_ = T_Type_vOut163 _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule734 #-} + rule734 = \ ((_argumentsIassumptions) :: Assumptions) ((_functionIassumptions) :: Assumptions) -> + _functionIassumptions `combine` _argumentsIassumptions + {-# INLINE rule735 #-} + rule735 = \ ((_argumentsIconstraints) :: KindConstraints) _newConstraint -> + _argumentsIconstraints ++ [_newConstraint] + {-# INLINE rule736 #-} + rule736 = \ ((_argumentsIkappaUnique) :: Int) -> + _argumentsIkappaUnique + 1 + {-# INLINE rule737 #-} + rule737 = \ ((_argumentsIkappaUnique) :: Int) -> + TVar _argumentsIkappaUnique + {-# INLINE rule738 #-} + rule738 = \ ((_argumentsIkappas) :: Kinds) ((_functionIkappa) :: Kind) ((_functionIself) :: Type) _kappa ((_rangeIself) :: Range) _self -> + (_functionIkappa <==> foldr (.->.) _kappa _argumentsIkappas) (kindApplication _rangeIself _self _functionIself) + {-# INLINE rule739 #-} + rule739 = \ ((_argumentsIself) :: Types) ((_functionIself) :: Type) ((_rangeIself) :: Range) prefix_ -> + Type_Application _rangeIself prefix_ _functionIself _argumentsIself + {-# INLINE rule740 #-} + rule740 = \ _self -> + _self + {-# INLINE rule741 #-} + rule741 = \ _kappa -> + _kappa + {-# INLINE rule742 #-} + rule742 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule743 #-} + rule743 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule744 #-} + rule744 = \ ((_functionIconstraints) :: KindConstraints) -> + _functionIconstraints + {-# INLINE rule745 #-} + rule745 = \ ((_functionIkappaUnique) :: Int) -> + _functionIkappaUnique +{-# NOINLINE sem_Type_Variable #-} +sem_Type_Variable :: T_Range -> T_Name -> T_Type +sem_Type_Variable arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIconstraints _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule746 _kappa _nameIself + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule747 _lhsIkappaUnique + _kappa = rule748 _lhsIkappaUnique + _self = rule749 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule750 _self + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule751 _lhsIconstraints + _lhsOkappa :: Kind + _lhsOkappa = rule752 _kappa + __result_ = T_Type_vOut163 _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule746 #-} + rule746 = \ _kappa ((_nameIself) :: Name) -> + single _nameIself _kappa + {-# INLINE rule747 #-} + rule747 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + 1 + {-# INLINE rule748 #-} + rule748 = \ ((_lhsIkappaUnique) :: Int) -> + TVar _lhsIkappaUnique + {-# INLINE rule749 #-} + rule749 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Variable _rangeIself _nameIself + {-# INLINE rule750 #-} + rule750 = \ _self -> + _self + {-# INLINE rule751 #-} + rule751 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule752 #-} + rule752 = \ _kappa -> + _kappa +{-# NOINLINE sem_Type_Constructor #-} +sem_Type_Constructor :: T_Range -> T_Name -> T_Type +sem_Type_Constructor arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIconstraints _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule753 _kappa _nameIself + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule754 _lhsIkappaUnique + _kappa = rule755 _lhsIkappaUnique + _self = rule756 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule757 _self + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule758 _lhsIconstraints + _lhsOkappa :: Kind + _lhsOkappa = rule759 _kappa + __result_ = T_Type_vOut163 _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule753 #-} + rule753 = \ _kappa ((_nameIself) :: Name) -> + single _nameIself _kappa + {-# INLINE rule754 #-} + rule754 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + 1 + {-# INLINE rule755 #-} + rule755 = \ ((_lhsIkappaUnique) :: Int) -> + TVar _lhsIkappaUnique + {-# INLINE rule756 #-} + rule756 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Constructor _rangeIself _nameIself + {-# INLINE rule757 #-} + rule757 = \ _self -> + _self + {-# INLINE rule758 #-} + rule758 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule759 #-} + rule759 = \ _kappa -> + _kappa +{-# NOINLINE sem_Type_Qualified #-} +sem_Type_Qualified :: T_Range -> T_ContextItems -> T_Type -> T_Type +sem_Type_Qualified arg_range_ arg_context_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIconstraints _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIkappaUnique _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 _contextOkappaUnique) + (T_Type_vOut163 _typeIassumptions _typeIconstraints _typeIkappa _typeIkappaUnique _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOconstraints _typeOkappaUnique) + (_assumptions,_kappa) = rule760 () + _self = rule761 _contextIself _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule762 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule763 _assumptions + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule764 _typeIconstraints + _lhsOkappa :: Kind + _lhsOkappa = rule765 _kappa + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule766 _typeIkappaUnique + _contextOkappaUnique = rule767 _lhsIkappaUnique + _typeOconstraints = rule768 _lhsIconstraints + _typeOkappaUnique = rule769 _contextIkappaUnique + __result_ = T_Type_vOut163 _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule760 #-} + rule760 = \ (_ :: ()) -> + internalError "KindInferencing.ag" "n/a" "Qualified types are not supported" + {-# INLINE rule761 #-} + rule761 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Qualified _rangeIself _contextIself _typeIself + {-# INLINE rule762 #-} + rule762 = \ _self -> + _self + {-# INLINE rule763 #-} + rule763 = \ _assumptions -> + _assumptions + {-# INLINE rule764 #-} + rule764 = \ ((_typeIconstraints) :: KindConstraints) -> + _typeIconstraints + {-# INLINE rule765 #-} + rule765 = \ _kappa -> + _kappa + {-# INLINE rule766 #-} + rule766 = \ ((_typeIkappaUnique) :: Int) -> + _typeIkappaUnique + {-# INLINE rule767 #-} + rule767 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule768 #-} + rule768 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule769 #-} + rule769 = \ ((_contextIkappaUnique) :: Int) -> + _contextIkappaUnique +{-# NOINLINE sem_Type_Forall #-} +sem_Type_Forall :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Forall arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIconstraints _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIassumptions _typeIconstraints _typeIkappa _typeIkappaUnique _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOconstraints _typeOkappaUnique) + (_assumptions,_kappa) = rule770 () + _self = rule771 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule772 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule773 _assumptions + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule774 _typeIconstraints + _lhsOkappa :: Kind + _lhsOkappa = rule775 _kappa + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule776 _typeIkappaUnique + _typeOconstraints = rule777 _lhsIconstraints + _typeOkappaUnique = rule778 _lhsIkappaUnique + __result_ = T_Type_vOut163 _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule770 #-} + rule770 = \ (_ :: ()) -> + internalError "KindInferencing.ag" "n/a" "Universal types are not supported" + {-# INLINE rule771 #-} + rule771 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Forall _rangeIself _typevariablesIself _typeIself + {-# INLINE rule772 #-} + rule772 = \ _self -> + _self + {-# INLINE rule773 #-} + rule773 = \ _assumptions -> + _assumptions + {-# INLINE rule774 #-} + rule774 = \ ((_typeIconstraints) :: KindConstraints) -> + _typeIconstraints + {-# INLINE rule775 #-} + rule775 = \ _kappa -> + _kappa + {-# INLINE rule776 #-} + rule776 = \ ((_typeIkappaUnique) :: Int) -> + _typeIkappaUnique + {-# INLINE rule777 #-} + rule777 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule778 #-} + rule778 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Type_Exists #-} +sem_Type_Exists :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Exists arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIconstraints _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIassumptions _typeIconstraints _typeIkappa _typeIkappaUnique _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOconstraints _typeOkappaUnique) + (_assumptions,_kappa) = rule779 () + _self = rule780 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule781 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule782 _assumptions + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule783 _typeIconstraints + _lhsOkappa :: Kind + _lhsOkappa = rule784 _kappa + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule785 _typeIkappaUnique + _typeOconstraints = rule786 _lhsIconstraints + _typeOkappaUnique = rule787 _lhsIkappaUnique + __result_ = T_Type_vOut163 _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule779 #-} + rule779 = \ (_ :: ()) -> + internalError "KindInferencing.ag" "n/a" "Existential types are not supported" + {-# INLINE rule780 #-} + rule780 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Exists _rangeIself _typevariablesIself _typeIself + {-# INLINE rule781 #-} + rule781 = \ _self -> + _self + {-# INLINE rule782 #-} + rule782 = \ _assumptions -> + _assumptions + {-# INLINE rule783 #-} + rule783 = \ ((_typeIconstraints) :: KindConstraints) -> + _typeIconstraints + {-# INLINE rule784 #-} + rule784 = \ _kappa -> + _kappa + {-# INLINE rule785 #-} + rule785 = \ ((_typeIkappaUnique) :: Int) -> + _typeIkappaUnique + {-# INLINE rule786 #-} + rule786 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule787 #-} + rule787 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique +{-# NOINLINE sem_Type_Parenthesized #-} +sem_Type_Parenthesized :: T_Range -> T_Type -> T_Type +sem_Type_Parenthesized arg_range_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIconstraints _lhsIkappaUnique) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIassumptions _typeIconstraints _typeIkappa _typeIkappaUnique _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOconstraints _typeOkappaUnique) + _self = rule788 _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule789 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule790 _typeIassumptions + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule791 _typeIconstraints + _lhsOkappa :: Kind + _lhsOkappa = rule792 _typeIkappa + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule793 _typeIkappaUnique + _typeOconstraints = rule794 _lhsIconstraints + _typeOkappaUnique = rule795 _lhsIkappaUnique + __result_ = T_Type_vOut163 _lhsOassumptions _lhsOconstraints _lhsOkappa _lhsOkappaUnique _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule788 #-} + rule788 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Parenthesized _rangeIself _typeIself + {-# INLINE rule789 #-} + rule789 = \ _self -> + _self + {-# INLINE rule790 #-} + rule790 = \ ((_typeIassumptions) :: Assumptions) -> + _typeIassumptions + {-# INLINE rule791 #-} + rule791 = \ ((_typeIconstraints) :: KindConstraints) -> + _typeIconstraints + {-# INLINE rule792 #-} + rule792 = \ ((_typeIkappa) :: Kind) -> + _typeIkappa + {-# INLINE rule793 #-} + rule793 = \ ((_typeIkappaUnique) :: Int) -> + _typeIkappaUnique + {-# INLINE rule794 #-} + rule794 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule795 #-} + rule795 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + +-- Types ------------------------------------------------------- +-- wrapper +data Inh_Types = Inh_Types { constraints_Inh_Types :: (KindConstraints), kappaUnique_Inh_Types :: (Int) } +data Syn_Types = Syn_Types { assumptions_Syn_Types :: (Assumptions), constraints_Syn_Types :: (KindConstraints), kappaUnique_Syn_Types :: (Int), kappas_Syn_Types :: (Kinds), self_Syn_Types :: (Types) } +{-# INLINABLE wrap_Types #-} +wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) +wrap_Types (T_Types act) (Inh_Types _lhsIconstraints _lhsIkappaUnique) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Types_vIn166 _lhsIconstraints _lhsIkappaUnique + (T_Types_vOut166 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOkappas _lhsOself) <- return (inv_Types_s167 sem arg) + return (Syn_Types _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOkappas _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Types #-} +sem_Types :: Types -> T_Types +sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) + +-- semantic domain +newtype T_Types = T_Types { + attach_T_Types :: Identity (T_Types_s167 ) + } +newtype T_Types_s167 = C_Types_s167 { + inv_Types_s167 :: (T_Types_v166 ) + } +data T_Types_s168 = C_Types_s168 +type T_Types_v166 = (T_Types_vIn166 ) -> (T_Types_vOut166 ) +data T_Types_vIn166 = T_Types_vIn166 (KindConstraints) (Int) +data T_Types_vOut166 = T_Types_vOut166 (Assumptions) (KindConstraints) (Int) (Kinds) (Types) +{-# NOINLINE sem_Types_Cons #-} +sem_Types_Cons :: T_Type -> T_Types -> T_Types +sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 _lhsIconstraints _lhsIkappaUnique) -> ( let + _hdX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) + _tlX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) + (T_Type_vOut163 _hdIassumptions _hdIconstraints _hdIkappa _hdIkappaUnique _hdIself) = inv_Type_s164 _hdX164 (T_Type_vIn163 _hdOconstraints _hdOkappaUnique) + (T_Types_vOut166 _tlIassumptions _tlIconstraints _tlIkappaUnique _tlIkappas _tlIself) = inv_Types_s167 _tlX167 (T_Types_vIn166 _tlOconstraints _tlOkappaUnique) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule796 _hdIassumptions _tlIassumptions + _lhsOkappas :: Kinds + _lhsOkappas = rule797 _hdIkappa _tlIkappas + _self = rule798 _hdIself _tlIself + _lhsOself :: Types + _lhsOself = rule799 _self + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule800 _tlIconstraints + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule801 _tlIkappaUnique + _hdOconstraints = rule802 _lhsIconstraints + _hdOkappaUnique = rule803 _lhsIkappaUnique + _tlOconstraints = rule804 _hdIconstraints + _tlOkappaUnique = rule805 _hdIkappaUnique + __result_ = T_Types_vOut166 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOkappas _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule796 #-} + rule796 = \ ((_hdIassumptions) :: Assumptions) ((_tlIassumptions) :: Assumptions) -> + _hdIassumptions `combine` _tlIassumptions + {-# INLINE rule797 #-} + rule797 = \ ((_hdIkappa) :: Kind) ((_tlIkappas) :: Kinds) -> + _hdIkappa : _tlIkappas + {-# INLINE rule798 #-} + rule798 = \ ((_hdIself) :: Type) ((_tlIself) :: Types) -> + (:) _hdIself _tlIself + {-# INLINE rule799 #-} + rule799 = \ _self -> + _self + {-# INLINE rule800 #-} + rule800 = \ ((_tlIconstraints) :: KindConstraints) -> + _tlIconstraints + {-# INLINE rule801 #-} + rule801 = \ ((_tlIkappaUnique) :: Int) -> + _tlIkappaUnique + {-# INLINE rule802 #-} + rule802 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule803 #-} + rule803 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique + {-# INLINE rule804 #-} + rule804 = \ ((_hdIconstraints) :: KindConstraints) -> + _hdIconstraints + {-# INLINE rule805 #-} + rule805 = \ ((_hdIkappaUnique) :: Int) -> + _hdIkappaUnique +{-# NOINLINE sem_Types_Nil #-} +sem_Types_Nil :: T_Types +sem_Types_Nil = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 _lhsIconstraints _lhsIkappaUnique) -> ( let + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule806 () + _lhsOkappas :: Kinds + _lhsOkappas = rule807 () + _self = rule808 () + _lhsOself :: Types + _lhsOself = rule809 _self + _lhsOconstraints :: KindConstraints + _lhsOconstraints = rule810 _lhsIconstraints + _lhsOkappaUnique :: Int + _lhsOkappaUnique = rule811 _lhsIkappaUnique + __result_ = T_Types_vOut166 _lhsOassumptions _lhsOconstraints _lhsOkappaUnique _lhsOkappas _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule806 #-} + rule806 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule807 #-} + rule807 = \ (_ :: ()) -> + [] + {-# INLINE rule808 #-} + rule808 = \ (_ :: ()) -> + [] + {-# INLINE rule809 #-} + rule809 = \ _self -> + _self + {-# INLINE rule810 #-} + rule810 = \ ((_lhsIconstraints) :: KindConstraints) -> + _lhsIconstraints + {-# INLINE rule811 #-} + rule811 = \ ((_lhsIkappaUnique) :: Int) -> + _lhsIkappaUnique diff --git a/src/Helium/StaticAnalysis/Inferencers/LocalInfo.ag b/src/Helium/StaticAnalysis/Inferencers/LocalInfo.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/LocalInfo.ag @@ -0,0 +1,294 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Make (local) information about the current node available +-- as a local attribute + +--------------------------------------------------------------------------------------- +-- FunctionBinding + +SEM FunctionBinding + | Hole + loc . localInfo = LocalInfo { self = UHA_FB @self + , assignedType = Nothing + , monos = @lhs.monos + } + | FunctionBinding + loc . localInfo = LocalInfo { self = UHA_FB @self + , assignedType = Nothing + , monos = @lhs.monos + } + +--------------------------------------------------------------------------------------- +-- Right-hand side expression + + +SEM RightHandSide + | Expression + loc . localInfo = LocalInfo { self = UHA_RHS @self + , assignedType = Nothing + , monos = @lhs.monos + } + | Guarded + loc . localInfo = LocalInfo { self = UHA_RHS @self + , assignedType = Nothing + , monos = @lhs.monos + } + +--------------------------------------------------------------------------------------- +-- Declaration + +SEM Declaration + | FunctionBindings + loc . localInfo = LocalInfo { self = UHA_Decl @self + , assignedType = Nothing + , monos = @lhs.monos + } + | PatternBinding + loc . localInfo = LocalInfo { self = UHA_Decl @self + , assignedType = Nothing + , monos = @lhs.monos + } + +--------------------------------------------------------------------------------------- +-- Expression + +SEM Expression + | Literal + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Variable + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Hole + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Constructor + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | NormalApplication + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | InfixApplication + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | If + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Lambda + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Case + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Let + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Do + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | List + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Tuple + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Comprehension + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Typed + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Enum + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Negate + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | NegateFloat + loc . localInfo = LocalInfo { self = UHA_Expr @self + , assignedType = Just @beta + , monos = @lhs.monos + } + +--------------------------------------------------------------------------------------- +-- Pattern + +SEM Pattern + | Hole + loc . localInfo = LocalInfo { self = UHA_Pat @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Literal + loc . localInfo = LocalInfo { self = UHA_Pat @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Variable + loc . localInfo = LocalInfo { self = UHA_Pat @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Constructor + loc . localInfo = LocalInfo { self = UHA_Pat @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | InfixConstructor + loc . localInfo = LocalInfo { self = UHA_Pat @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | List + loc . localInfo = LocalInfo { self = UHA_Pat @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Tuple + loc . localInfo = LocalInfo { self = UHA_Pat @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Negate + loc . localInfo = LocalInfo { self = UHA_Pat @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | As + loc . localInfo = LocalInfo { self = UHA_Pat @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | Wildcard + loc . localInfo = LocalInfo { self = UHA_Pat @self + , assignedType = Just @beta + , monos = @lhs.monos + } + | NegateFloat + loc . localInfo = LocalInfo { self = UHA_Pat @self + , assignedType = Just @beta + , monos = @lhs.monos + } + +--------------------------------------------------------------------------------------- +-- Statement + +SEM Statement + | Expression + loc . localInfo = LocalInfo { self = UHA_Stat @self + , assignedType = Nothing + , monos = @lhs.monos + } + | Let + loc . localInfo = LocalInfo { self = UHA_Stat @self + , assignedType = Nothing + , monos = @lhs.monos + } + | Generator + loc . localInfo = LocalInfo { self = UHA_Stat @self + , assignedType = Nothing + , monos = @lhs.monos + } + | Empty + loc . localInfo = LocalInfo { self = UHA_Stat @self + , assignedType = Nothing + , monos = @lhs.monos + } + +--------------------------------------------------------------------------------------- +-- Qualifier + +SEM Qualifier + | Guard + loc . localInfo = LocalInfo { self = UHA_Qual @self + , assignedType = Nothing + , monos = @lhs.monos + } + | Let + loc . localInfo = LocalInfo { self = UHA_Qual @self + , assignedType = Nothing + , monos = @lhs.monos + } + | Generator + loc . localInfo = LocalInfo { self = UHA_Qual @self + , assignedType = Nothing + , monos = @lhs.monos + } + | Empty + loc . localInfo = LocalInfo { self = UHA_Qual @self + , assignedType = Nothing + , monos = @lhs.monos + } + +--------------------------------------------------------------------------------------- +-- (Non-terminals above) Declarations + +SEM Body + | Body + loc . declInfo = LocalInfo { self = UHA_Decls @declarations.self + , assignedType = Nothing + , monos = @lhs.monos + } +SEM MaybeDeclarations + | Just + loc . declInfo = LocalInfo { self = UHA_Decls @declarations.self + , assignedType = Nothing + , monos = @lhs.monos + } +SEM Expression + | Let + loc . declInfo = LocalInfo { self = UHA_Decls @declarations.self + , assignedType = Nothing + , monos = @lhs.monos + } +SEM Statement + | Let + loc . declInfo = LocalInfo { self = UHA_Decls @declarations.self + , assignedType = Nothing + , monos = @lhs.monos + } +SEM Qualifier + | Let + loc . declInfo = LocalInfo { self = UHA_Decls @declarations.self + , assignedType = Nothing + , monos = @lhs.monos + } diff --git a/src/Helium/StaticAnalysis/Inferencers/PatternMatchWarnings.ag b/src/Helium/StaticAnalysis/Inferencers/PatternMatchWarnings.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/PatternMatchWarnings.ag @@ -0,0 +1,477 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Generates warnings for incomplete and overlapping pattern matches +-- (PatternMatchWarnings.ag by Maarten Loffler) +-- +----------------------------------------------------------------------------- + +imports { +import Helium.Syntax.UHA_Utils +} + +{ +pmError :: String -> String -> a +pmError = internalError "PatternMatchWarnings" +} + +-- substitution is needed for the type of a pattern +-- new warnings attribute to avoid problems with other warnings +-- warnings are merged in "TypeInferencing.ag" +ATTR Expression Expressions MaybeExpression Pattern Patterns Alternative Alternatives + Statement Statements Declaration Declarations MaybeDeclarations LeftHandSide RightHandSide + FunctionBinding FunctionBindings Body Qualifier Qualifiers + GuardedExpression GuardedExpressions + RecordExpressionBinding RecordExpressionBindings + RecordPatternBinding RecordPatternBindings + [ | patternMatchWarnings : {[Warning]} | ] + +SEM Module + | Module body . patternMatchWarnings = [] + +-- attributes to convert a Pattern to a [PatternElement] +ATTR LeftHandSide Pattern Literal [ || elements : { [PatternElement] }] +ATTR Patterns [ || elementss : {[ [PatternElement] ]}] +ATTR FunctionBinding Alternative [ || elements : { ([PatternElement], Bool) }] +ATTR FunctionBindings Alternatives [ || elementss : {[([PatternElement], Bool)]}] + +ATTR FunctionBinding Alternative [ || unrwar : Warning ] +ATTR FunctionBindings Alternatives [ || unrwars : {[Warning]}] + +ATTR FunctionBinding FunctionBindings LeftHandSide [ || argcount : Int] + +SEM FunctionBindings + | Nil lhs . elementss = [] + lhs . unrwars = [] + lhs . argcount = pmError "FunctionBindings_Nil.argcount" "?empty list of function bindings?" + | Cons lhs . elementss = @hd.elements : @tl.elementss + lhs . unrwars = @hd.unrwar : @tl.unrwars + lhs . argcount = @hd.argcount + +SEM FunctionBinding + | Hole lhs . argcount = 0 + . elements = ([], False) + . unrwar = pmError "FunctionBinding_Hole.unrwar" "hole unrwar" + | FunctionBinding lhs . unrwar = UnreachablePatternLHS @lefthandside.self + lhs . elements = (@lefthandside.elements, @righthandside.fallthrough) + +SEM LeftHandSide + | Function lhs . elements = concat @patterns.elementss + lhs . argcount = length @patterns.self + | Infix lhs . elements = @leftPattern.elements ++ @rightPattern.elements + lhs . argcount = 2 + +SEM Alternatives + | Nil lhs . elementss = [] + lhs . unrwars = [] + | Cons lhs . elementss = @hd.elements : @tl.elementss + lhs . unrwars = @hd.unrwar : @tl.unrwars + +SEM Alternative + | Hole lhs . elements = ([], False) + lhs . unrwar = pmError "Alternative_Empty.unrwar" "empty alternative" + | Alternative lhs . elements = (@pattern.elements, @righthandside.fallthrough) + lhs . unrwar = UnreachablePatternCase @range.self @pattern.self + | Empty lhs . elements = ([], False) + lhs . unrwar = pmError "Alternative_Empty.unrwar" "empty alternative" + +SEM Patterns + | Nil lhs . elementss = [] + | Cons lhs . elementss = @hd.elements : @tl.elementss + +SEM Pattern + | Hole lhs . elements = [FiniteElement hole] + | Variable lhs . elements = [WildcardElement] + | Wildcard lhs . elements = [WildcardElement] + | Constructor lhs . elements = FiniteElement (getNameName @name.self) : concat @patterns.elementss + | InfixConstructor lhs . elements = FiniteElement (getNameName @constructorOperator.self) : @leftPattern.elements ++ @rightPattern.elements + | Record lhs . elements = pmError "Pattern_Record.elements" "Records are not supported" + | Successor lhs . elements = pmError "Pattern_Successor.elements" "Successors are not supported" + | Tuple lhs . elements = FiniteElement ("(" ++ replicate (length $ tail @patterns.self) ',' ++ ")") : concat @patterns.elementss + | List lhs . elements = listPat @patterns.elementss + +SEM Literal + | Int lhs . elements = [InfiniteElement @value] + | Char lhs . elements = [InfiniteElement @value] + | Float lhs . elements = [InfiniteElement @value] + | String lhs . elements = stringPat @value + +-- putting everything together +{ +expandTypeFromImportEnvironment :: ImportEnvironment -> Tp -> Tp +expandTypeFromImportEnvironment env = expandType (snd $ getOrderedTypeSynonyms env) + +patternMatchWarnings :: Substitution substitution + => ImportEnvironment -- the importenvironment + -> substitution -- substitution that contains the real types + -> Tp -- type of the patterns, unsubstituted + -> (Tp -> Tps) -- how should the type be interpreted? + -> [([PatternElement], Bool)] -- the patterns to be processed + -> Range -- range for the missing-warnings + -> Maybe Name -- maybe the name of the function + -> Bool -- should there be parentheses around the patterns? + -> [Warning] -- list of overlap-warnings for all of the patterns + -> String -- description of the place where the patterns are + -> String -- symbol after the patterns + -> [Warning] -- returns: list of warnings +patternMatchWarnings impenv sub tp strip elementss rng name parens unrwars place sym + = unreachablewarnings ++ missingwarnings + where + env = importEnvironmentToEnv impenv + exprtype = expandTypeFromImportEnvironment impenv $ sub |-> tp + types = strip exprtype + unreachables = unreachable impenv types $ map (\((a, _), c) -> (a, c)) $ filter (not.snd.fst) $ zip elementss [0..] + missing = complement impenv types $ map fst elementss + unreachablewarnings = map (unrwars !!) unreachables + missingwarnings + | null $ unMissing missing = [] + | otherwise = [MissingPatterns rng name exprtype (map (nicePattern parens env) $ missingList missing) place sym] +} + +SEM Expression + | Case lhs . patternMatchWarnings = patternMatchWarnings @lhs.importEnvironment + @lhs.substitution + @expression.beta + (:[]) + @alternatives.elementss + @range.self + Nothing + False + @alternatives.unrwars + "case expression" + "->" + ++ @alternatives.patternMatchWarnings + | Lambda lhs . patternMatchWarnings = patternMatchWarnings @lhs.importEnvironment + @lhs.substitution + @loc.beta + (take (length @patterns.self) . fst . functionSpine) + [(concat @patterns.elementss, False)] + @range.self + (Just $ Name_Special noRange [] "\\") -- !!!Name + True + [] + "lambda expression" + "->" + ++ @expression.patternMatchWarnings + +SEM Declaration + | FunctionBindings lhs . patternMatchWarnings = patternMatchWarnings @lhs.importEnvironment + @lhs.substitution + @loc.beta + (take @bindings.argcount . fst . functionSpine) + @bindings.elementss + @range.self + (Just @bindings.name) + True + @bindings.unrwars + "function bindings" + "=" + ++ @bindings.patternMatchWarnings + | PatternBinding lhs . patternMatchWarnings = patternMatchWarnings @lhs.importEnvironment + @lhs.substitution + @pattern.beta + (:[]) + [(@pattern.elements, @righthandside.fallthrough)] + @range.self + Nothing + False + [] + "pattern binding" + "=" + ++ @righthandside.patternMatchWarnings + +SEM Statement + | Generator lhs . patternMatchWarnings = patternMatchWarnings @lhs.importEnvironment + @lhs.substitution + @pattern.beta + (:[]) + [(@pattern.elements, False)] + @range.self + Nothing + False + [] + "generator" + "<-" + ++ @expression.patternMatchWarnings + +SEM Qualifier + | Generator lhs . patternMatchWarnings = patternMatchWarnings @lhs.importEnvironment + @lhs.substitution + @pattern.beta + (:[]) + [(@pattern.elements, False)] + @range.self + Nothing + False + [] + "generator" + "<-" + ++ @expression.patternMatchWarnings + +ATTR RightHandSide GuardedExpression GuardedExpressions [ || fallthrough : Bool ] +ATTR GuardedExpressions [ open : Bool || ] +ATTR GuardedExpression [ || range : Range ] +ATTR GuardedExpression [ || unrwar : Warning ] + +SEM RightHandSide + | Expression lhs . fallthrough = False + | Guarded lhs . fallthrough = @guardedexpressions.fallthrough + guardedexpressions . open = True + lhs . patternMatchWarnings = (if @guardedexpressions.fallthrough then [FallThrough @range.self] else []) + ++ @where.patternMatchWarnings + +SEM GuardedExpressions + | Nil lhs . fallthrough = True + | Cons lhs . fallthrough = @hd.fallthrough && @tl.fallthrough + tl . open = @hd.fallthrough && @lhs.open + lhs . patternMatchWarnings = (if not @lhs.open then [@hd.unrwar] else []) + ++ @tl.patternMatchWarnings + +SEM GuardedExpression + | GuardedExpression lhs . fallthrough = case @guard.self + of Expression_Variable _ (Name_Identifier _ _ "otherwise") -> False -- !!!Name + Expression_Constructor _ (Name_Identifier _ _ "True" ) -> False -- !!!Name + _ -> True + lhs . unrwar = UnreachableGuard @range.self @guard.self + +SEM GuardedExpression + | GuardedExpression lhs . range = @range.self + +{ + +---------- +-- misc -- +---------- + +-- lifted or +(|^|) :: (a -> Bool) -> (a -> Bool) -> a -> Bool +(|^|) f g x = f x || g x + +---------------------------------------------- +--- environments and substitution of types --- +---------------------------------------------- + +-- environment of constructors [(type, (constructorname, arguments))] +type Env = [(Tp, (Name, [Tp]))] + +importEnvironmentToEnv :: ImportEnvironment -> [(Tp, (Name, [Tp]))] +importEnvironmentToEnv = map rearrange . M.assocs . valueConstructors + +-- return the number of arguments of a constructor +-- tuples ar not in the Env so they require special treatment +nrOfArguments :: Env -> String -> Int +nrOfArguments env con | isTupleConstructor con = length con - 1 + | otherwise = case lookup (nameFromString con) $ map snd env + of Just args -> length args + Nothing -> 0 + +-- convert constructor to fit in an Env +rearrange :: (Name, TpScheme) -> (Tp, (Name, [Tp])) +rearrange (name, tpscheme) = let (args, res) = functionSpine $ unqualify $ unquantify tpscheme + in (res, (name, args)) + +-- get the constructors of a given type out of an Env +-- tuples ar not in the Env so they require special treatment +constructors :: ImportEnvironment -> Tp -> [(Name, [Tp])] +constructors _ (TVar _) = [] +constructors impenv tp | isTupleConstructor name = [tupleconstructor] + | otherwise = map expand $ concatMap (substitute tp) $ importEnvironmentToEnv impenv + where + name :: String + name = unTCon $ fst $ leftSpine tp + tupleconstructor :: (Name, [Tp]) + tupleconstructor = (nameFromString name, snd $ leftSpine tp) + unTCon :: Tp -> String + unTCon (TCon c) = c + unTCon tp' = pmError "unTCon" $ "type " ++ show tp' ++ " is not a TCon" + expand :: (Name, [Tp]) -> (Name, [Tp]) + expand (n, ts) = (n, map (expandTypeFromImportEnvironment impenv) ts) + +-- check of an entry in an Env is a constructor for the given type +-- if so, return this constructor, but with variables substituted for whatever is in the given type +-- the list returns zero or one elements +-- for example: substitute (Maybe Int) (Maybe a, (Just, [a])) will return [(Just, [Int])] +substitute :: Tp -> (Tp, (Name, [Tp])) -> [(Name, [Tp])] +substitute t1 (t2, (con, args)) = let (c1, ts1) = leftSpine t1 + (c2, ts2) = leftSpine t2 + sub = listToSubstitution $ zip (map unTVar ts2) ts1 + in if c1 == c2 + then [(con, map (sub |->) args)] + else [] + where + unTVar :: Tp -> Int + unTVar (TVar v) = v + unTVar _ = pmError "unTVar" "type is not a TVar" + +--------------------------------------------------------------- +--- datastructures and functions for the solution structure --- +--------------------------------------------------------------- + +-- a pattern is a list of patternelements +data PatternElement = WildcardElement | InfiniteElement String | FiniteElement String deriving Eq +isInfiniteElement :: PatternElement -> Bool +isInfiniteElement (InfiniteElement _) = True +isInfiniteElement _ = False +elementString :: PatternElement -> String +elementString (InfiniteElement s) = s +elementString ( FiniteElement s) = s +elementString _ = [] + +-- needed for Pattern_List and Literal_String occurences +listPat :: [[PatternElement]] -> [PatternElement] +listPat [] = [FiniteElement "[]"] +listPat (ps:pss) = FiniteElement ":" : ps ++ listPat pss + +stringPat :: String -> [PatternElement] +stringPat [] = [FiniteElement "[]"] +stringPat (c:cs) = FiniteElement ":" : InfiniteElement [c] : stringPat cs + +-- tree of missing patterns +data PatternsMissing = PatternsMissing [(PatternElement, PatternsMissing)] +unMissing :: PatternsMissing -> [(PatternElement, PatternsMissing)] +unMissing (PatternsMissing l) = l + +-- create a branch consisting of only wildcards +wildMissing :: Int -> PatternsMissing +wildMissing 0 = PatternsMissing [] +wildMissing n = PatternsMissing [(WildcardElement, wildMissing $ n - 1)] + +-- convert a missing patterns tree to a list of seperated missing patterns +missingList :: PatternsMissing -> [[PatternElement]] +missingList (PatternsMissing []) = [[]] +missingList (PatternsMissing [(d,t)]) = map (d:) $ missingList t +missingList (PatternsMissing (d:ds)) = (missingList $ PatternsMissing [d]) ++ (missingList $ PatternsMissing ds) + +------------------------------------------------------------------- +--- functions to create a UHA_Pattern out of a [PatternElement] --- +------------------------------------------------------------------- + +-- nice creates the actual pattern without parentheses +-- [Just, True, True, (,), Just, Nothing, False] -> [Just True, True, (Just Nothing, False)] +nicePattern :: Bool -> Env -> [PatternElement] -> [Pattern] +nicePattern b env = map (parensPattern b) . nice + where + nice :: [PatternElement] -> [Pattern] + nice [] = [] + nice (WildcardElement :ps) = Pattern_Wildcard noRange : nice ps + nice (InfiniteElement _ :_) = pmError "nicePattern" "InfiniteElement in pattern!" + nice (FiniteElement con:ps) = + let rest = nice ps + name = nameFromString con + n = nrOfArguments env con + in case name + of Name_Identifier _ _ _ -> Pattern_Constructor noRange name (take n rest) : drop n rest -- !!!Name + Name_Operator _ _ _ | con == ":" -> case head $ tail rest -- !!!Name + of Pattern_List _ pats -> Pattern_List noRange (head rest:pats) : (tail $ tail rest) + _ -> Pattern_InfixConstructor noRange (head rest) name (head $ tail rest) : (tail $ tail rest) + | otherwise -> Pattern_InfixConstructor noRange (head rest) name (head $ tail rest) : (tail $ tail rest) + Name_Special _ _ _ | isTupleConstructor con -> Pattern_Tuple noRange (take n rest) : drop n rest -- !!!Name + | con == "[]" -> Pattern_List noRange [] : rest + | otherwise -> Pattern_Constructor noRange name (take n rest) : drop n rest + +-- add parentheses to a pattern in the correct places +-- bool means: if needed, should there be parenthesis around the complete pattern? +parensPattern :: Bool -> Pattern -> Pattern +parensPattern b = if b then rap . par else fst . par + where + par :: Pattern -> (Pattern, Bool) -- Bool means: are parentheses needed around this pattern, shoud it be used in a more complex pattern + par p@(Pattern_Literal _ _ ) = (p, False) + par p@(Pattern_Variable _ _ ) = (p, False) + par (Pattern_Constructor r n ps ) = (Pattern_Constructor r n $ map (rap.par) ps, length ps > 0) + par (Pattern_Parenthesized _ p ) = par p + par (Pattern_InfixConstructor r l n k) = (Pattern_InfixConstructor r (rap $ par l) n (rap $ par k), True) + par (Pattern_List r ps ) = (Pattern_List r $ map (fst.par) ps, False) + par (Pattern_Tuple r ps ) = (Pattern_Tuple r $ map (fst.par) ps, False) + par (Pattern_Record _ _ _ ) = pmError "parensPattern" "Records are not supported" + par p@(Pattern_Negate _ _ ) = (p, True) + par p@(Pattern_NegateFloat _ _ ) = (p, True) + par (Pattern_As r n p ) = (Pattern_As r n (rap $ par p), False) + par p@(Pattern_Wildcard _ ) = (p, False) + par (Pattern_Irrefutable _ _ ) = pmError "parensPattern" "Irrefutable patterns are not supported" + par (Pattern_Successor _ _ _ ) = pmError "parensPattern" "Successors are not supported" + par (Pattern_Hole _ _ ) = error "not supported" + rap :: (Pattern, Bool) -> Pattern + rap (p, False) = p + rap (p, True ) = Pattern_Parenthesized noRange p + +-------------------------------------- +--- finally, the algorithm itself! --- +-------------------------------------- + +-- returns the tree of missing patterns for a given list of patterns +complement :: ImportEnvironment -> [Tp] -> [[PatternElement]] -> PatternsMissing +complement _ [] _ = PatternsMissing [] +complement _ _ ([]:_) = PatternsMissing [] +complement env (tp:tps) pss | null $ unMissing anyComplement = PatternsMissing [] + | all (((== WildcardElement) |^| isInfiniteElement).head) pss = anyComplement + | otherwise = finComplement + where + patComplement :: [[PatternElement]] -> PatternElement -> [Tp] -> PatternsMissing + patComplement [] current typs = PatternsMissing [(current, wildMissing $ length typs)] + patComplement patss current typs = case unMissing $ complement env typs $ map tail $ patss + of [] -> PatternsMissing [] + tegs -> PatternsMissing [(current, PatternsMissing tegs)] + anyComplement :: PatternsMissing + anyComplement = patComplement (filter ((== WildcardElement).head) pss) WildcardElement tps + conComplement :: (Name, [Tp]) -> PatternsMissing + conComplement (con, args) = patComplement ( filter ((== FiniteElement (getNameName con)).head) pss + ++ map (\ps -> FiniteElement (getNameName con) : replicate (length args) WildcardElement ++ tail ps) + (filter ((== WildcardElement).head) pss) + ) + (FiniteElement (getNameName con)) (args ++ tps) + finComplement :: PatternsMissing + finComplement = case constructors env tp + of [] -> wildMissing $ 1 + length tps + cons -> PatternsMissing $ concatMap (unMissing.conComplement) cons + +---------------------------- +--- unreachable patterns --- +---------------------------- + +-- complements the list of reachable patterns +unreachable :: ImportEnvironment -> [Tp] -> [([PatternElement], Int)] -> [Int] +unreachable env tps ps = let reach = reachable env tps ps + in filter (not . flip elem reach) (map snd ps) + +-- determines which patterns are reachable +-- possibly multiple occurances of indices +reachable :: ImportEnvironment -> [Tp] -> [([PatternElement], Int)] -> [Int] +reachable _ [] _ = pmError "reachable" "empty type list!" +reachable env (tp:tps) ps + | all ((== WildcardElement).head.fst) ps = conReachable ps + | otherwise = concat $ map (conReachable.conPats) $ stop cons + where + cons :: [PatternElement] + cons = thin $ map (head.fst) ps + conPats :: PatternElement -> [([PatternElement], Int)] + conPats con = map (\(es, i) -> (fill con es, i)) $ filter (((== con) |^| (== WildcardElement)).head.fst) ps + fill :: PatternElement -> [PatternElement] -> [PatternElement] + fill e@(FiniteElement c) (WildcardElement : es) = e : replicate (nrOfArguments (importEnvironmentToEnv env) c) WildcardElement ++ es + fill e (_ : es) = e : es + fill _ [] = error "Pattern match failure in StaticAnalysis.Inferencers.reachable" + stop :: [PatternElement] -> [PatternElement] + stop es | length (constructors env tp) > length es = FiniteElement "[*]" : es + | length (constructors env tp) == 0 = FiniteElement "[*]" : es + | otherwise = es + conReachable :: [([PatternElement], Int)] -> [Int] + conReachable [] = [] + conReachable pats + | null.tail.fst.head $ pats = [snd.head $ pats] + | otherwise = reachable env (arguments (elementString.head.fst.head $ pats) ++ tps) + $ map (\(es, i) -> (tail es, i)) pats + arguments :: String -> [Tp] + arguments c = maybe [] id $ lookup c $ map (\(n, typs) -> (getNameName n, typs)) $ constructors env tp + +-- remove double occurances and wildcards +thin :: [PatternElement] -> [PatternElement] +thin [] = [] +thin (WildcardElement : es) = thin es +thin (e : es) | elem e thines = thines + | otherwise = e : thines + where thines = thin es + +} diff --git a/src/Helium/StaticAnalysis/Inferencers/SelectConstraintSolver.hs b/src/Helium/StaticAnalysis/Inferencers/SelectConstraintSolver.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/SelectConstraintSolver.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE UndecidableInstances, OverlappingInstances #-} + +{-| Module : SelectConstraintSolver + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Select the type constraint solver of your own liking +-} + +module Helium.StaticAnalysis.Inferencers.SelectConstraintSolver (selectConstraintSolver) where + +import Helium.Main.Args (Option(..)) +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints +import Helium.ModuleSystem.ImportEnvironment (ImportEnvironment, getSiblings) +import Helium.StaticAnalysis.Heuristics.ListOfHeuristics (listOfHeuristics) +import Top.Types +import Top.Solver +import Top.Ordering.TreeWalk +import Top.Ordering.Tree +import Top.Solver.Greedy +import Top.Solver.TypeGraph +import Top.Solver.PartitionCombinator +import Top.Solver.SwitchCombinator +import Top.Interface.Substitution (makeSubstConsistent) + +type TreeSolver = ClassEnvironment -> OrderedTypeSynonyms -> Int + -> Tree (TypeConstraint ConstraintInfo) -> (SolveResult ConstraintInfo, LogEntries) + +selectConstraintSolver :: [Option] -> ImportEnvironment -> TreeSolver +selectConstraintSolver options importenv classEnv synonyms unique constraintTree = + solve selectedOptions constraints selectedSolver + + where + -- spread type constraints or not (i.e., map some type constraints to a + -- corresponding node in the constraint tree) + -- spreading is enabled by default + spreadingOrNot + | NoSpreading `elem` options = id + | otherwise = spreadTree spreadFunction + + -- choose your treewalk to flatten the constraint tree + -- the default treewalk is TreeWalkInorderTopLastPost (similar to 'W') + simpleTreeWalk + | TreeWalkTopDown `elem` options = topDownTreeWalk + | TreeWalkBottomUp `elem` options = bottomUpTreeWalk + | TreeWalkInorderTopFirstPre `elem` options = inorderTopFirstPreTreeWalk + | TreeWalkInorderTopLastPre `elem` options = inorderTopLastPreTreeWalk + | TreeWalkInorderTopFirstPost `elem` options = inorderTopFirstPostTreeWalk + | otherwise = inorderTopLastPostTreeWalk + + selectedTreeWalk + | RightToLeft `elem` options = reverseTreeWalk simpleTreeWalk + | otherwise = simpleTreeWalk + + phases = phaseTree (TCOper "MakeConsistent" makeSubstConsistent) + flattening = flattenTree selectedTreeWalk . phases . spreadingOrNot + + constraints = flattening constraintTree + chunkConstraints = chunkTree . phases . spreadTree spreadFunction $ constraintTree + siblings = getSiblings importenv + + selectedOptions :: SolveOptions + selectedOptions = + solveOptions { uniqueCounter = unique + , typeSynonyms = synonyms + , classEnvironment = classEnv + } + + selectedSolver :: ConstraintSolver (TypeConstraint ConstraintInfo) ConstraintInfo + selectedSolver + | SolverSimple `elem` options = greedySimpleConstraintSolver + | SolverGreedy `elem` options = greedyConstraintSolver + | SolverTypeGraph `elem` options = typegraphConstraintSolver heuristics + | SolverCombination `elem` options = combinedSolver + | otherwise = + solveChunkConstraints polySubst combinedSolver (flattenTree selectedTreeWalk) chunkConstraints + + combinedSolver = + -- (if SignatureWarnings `elem` options then warnForTooSpecificSignatures runGreedy else runGreedy) + greedyConstraintSolver |>>| typegraphConstraintSolver heuristics + + heuristics = listOfHeuristics options siblings + + +{- +warnForTooSpecificSignatures :: SolverX (TypeConstraint ConstraintInfo) ConstraintInfo Predicates Warnings -> SolverX (TypeConstraint ConstraintInfo) ConstraintInfo Predicates Warnings +warnForTooSpecificSignatures solver classEnv synonyms unique constraints = + let -- split the constraints that come from an explicit type signature from the others. + -- (only for the definition, not for the uses) + (explicits, normalConstraints) = partition (isJust . maybeExplicitlyTyped) constraints + -- make new (equality) constraints for the explicits + newConstraints = concatMap makeNewConstraint + . groupBy (\x y -> fst x == fst y) + . sortBy (\x y -> fst x `compare` fst y) + $ map (fromJust . maybeExplicitlyTyped) explicits + + -- first solve the new constraint set and the "normal" constraints. Try to determine an "inferred" and more general + -- type from this result. Then, solve the explicit constraints that were skipped to make the final substitution as + -- it would be originally. + result1 = solver classEnv synonyms unique (newConstraints ++ normalConstraints) + result2 = solver classEnv synonyms (uniqueFromResult result1) (substitutionFromResult result1 |-> explicits) + + -- make the warnings + warnings = + let f (monos, name, tp, signature) = + let ms = substitutionFromResult result1 |-> monos + ps = qualifiersFromResult result1 + ts = makeScheme (ftv ms) ps (substitutionFromResult result1 |-> tp) + b1 = genericInstanceOf synonyms classEnv signature ts + b2 = genericInstanceOf synonyms classEnv ts signature + in [ SignatureTooSpecific name signature ts | b1 && not b2 ] + + in [ warning | Just x <- map splitExplicit explicits, warning <- f x ] + + in (result1 { extensionFromResult = warnings ++ extensionFromResult result1 }) `plus` result2 + + where + makeNewConstraint :: [(NameWithRange, Tp)] -> [TypeConstraint ConstraintInfo] + makeNewConstraint [] = [] + makeNewConstraint ((name, t1):rest) = + let info = cinfoSameBindingGroup (nameWithRangeToName name) + in [ (t1 .==. t2) info | (_, t2) <- rest ] + + maybeExplicitlyTyped :: TypeConstraint ConstraintInfo -> Maybe (NameWithRange, Tp) + maybeExplicitlyTyped (TC3 (Skolemize tp _ info)) = + do (monos, name) <- maybeExplicitTypedDefinition info + return (NameWithRange name, tp) + maybeExplicitlyTyped _ = Nothing + + splitExplicit :: TypeConstraint ConstraintInfo -> Maybe (Tps, Name, Tp, TpScheme) + splitExplicit (TC3 (Skolemize tp (_, SigmaScheme tpscheme) info)) + | isExplicitTypedBinding info = + do (monos, name) <- maybeExplicitTypedDefinition info + return (monos, name, tp, tpscheme) + splitExplicit _ = Nothing + +instance Show Warning where show _ = "" +instance IsState Warnings -} diff --git a/src/Helium/StaticAnalysis/Inferencers/TypeInferenceCollect.ag b/src/Helium/StaticAnalysis/Inferencers/TypeInferenceCollect.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/TypeInferenceCollect.ag @@ -0,0 +1,231 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Distributition of +-- * import environment +-- * substitution (result of solving the type constraints) +-- * inferred types +-- * ordered type synonyms +-- +----------------------------------------------------------------------------- + +ATTR Expression Expressions MaybeExpression Alternative Alternatives + Statement Statements Declaration Declarations MaybeDeclarations + RightHandSide Body Qualifier Qualifiers + GuardedExpression GuardedExpressions FunctionBinding FunctionBindings + RecordExpressionBinding RecordExpressionBindings + [ importEnvironment : ImportEnvironment + substitution : FixpointSubstitution + typeschemeMap : {M.Map Int (Scheme Predicates)} + allTypeSchemes : {M.Map NameWithRange TpScheme} + orderedTypeSynonyms : OrderedTypeSynonyms + | collectWarnings : Warnings + collectErrors : TypeErrors + | + ] + +ATTR LeftHandSide Pattern Patterns [ importEnvironment : ImportEnvironment | | ] + +---------------------------------------------------------------------------------------- +-- Collecting missing type signature warnings + +SEM Module + | Module body . collectWarnings = [] + . collectErrors = [] + +SEM Body + | Body loc . inferredTypes = findInferredTypes @lhs.typeschemeMap @implicitsFM + lhs . collectWarnings = missingTypeSignature True @declarations.simplePatNames @inferredTypes + ++ @declarations.collectWarnings + . collectErrors = restrictedNameErrors @inferredTypes @declarations.restrictedNames + ++ @declarations.collectErrors + +SEM MaybeDeclarations + | Just loc . inferredTypes = findInferredTypes @lhs.typeschemeMap @implicitsFM + lhs . collectWarnings = missingTypeSignature False @declarations.simplePatNames @inferredTypes + ++ @declarations.collectWarnings + . collectErrors = restrictedNameErrors @inferredTypes @declarations.restrictedNames + ++ @declarations.collectErrors + +SEM Expression + | Let loc . inferredTypes = findInferredTypes @lhs.typeschemeMap @implicitsFM + lhs . collectWarnings = missingTypeSignature False @declarations.simplePatNames @inferredTypes + ++ @expression.collectWarnings + . collectErrors = restrictedNameErrors @inferredTypes @declarations.restrictedNames + ++ @declarations.collectErrors + +SEM Statement + | Let loc . inferredTypes = findInferredTypes @lhs.typeschemeMap @implicitsFM + lhs . collectWarnings = missingTypeSignature False @declarations.simplePatNames @inferredTypes + ++ @declarations.collectWarnings + . collectErrors = restrictedNameErrors @inferredTypes @declarations.restrictedNames + ++ @declarations.collectErrors + +SEM Qualifier + | Let loc . inferredTypes = findInferredTypes @lhs.typeschemeMap @implicitsFM + lhs . collectWarnings = missingTypeSignature False @declarations.simplePatNames @inferredTypes + ++ @declarations.collectWarnings + . collectErrors = restrictedNameErrors @inferredTypes @declarations.restrictedNames + ++ @declarations.collectErrors + +{ +findInferredTypes :: M.Map Int (Scheme Predicates) -> M.Map Name (Sigma Predicates) -> TypeEnvironment +findInferredTypes typeschemeMap = + let err = internalError "TypeInferenceCollect.ag" "findInferredTypes" "could not find type scheme variable" + f :: Sigma Predicates -> TpScheme + f (SigmaVar i) = M.findWithDefault err i typeschemeMap + f (SigmaScheme ts) = ts + in M.map f + +missingTypeSignature :: Bool -> Names -> TypeEnvironment -> Warnings +missingTypeSignature topLevel simplePats = + let -- for the moment, only missing type signature for top-level functions are reported (unless monomorphic). + makeWarning (name, scheme) = + let fromSimple = name `elem` simplePats && isOverloaded scheme + in [ NoTypeDef name scheme topLevel fromSimple | null (ftv scheme) && (topLevel || fromSimple) ] + in concatMap makeWarning . M.assocs + +restrictedNameErrors :: TypeEnvironment -> Names -> TypeErrors +restrictedNameErrors env = + let f name = case M.lookup name env of + Just scheme -> [ makeRestrictedButOverloadedError name scheme | isOverloaded scheme ] + Nothing -> [] + in concatMap f + +} + +---------------------------------------------------------------------------------------- +-- Collecting inferred top level types + +ATTR Body [ | | toplevelTypes : TypeEnvironment ] + +SEM Body + | Hole lhs . toplevelTypes = M.empty + | Body lhs . toplevelTypes = @declarations.typeSignatures `M.union` @inferredTypes + +--------------------------------------------------------- +-- Collecting all the type schemes that are in scope + +{- bug fix 10 september 2003: the inferred types for where-declarations are also "visible" in the expression of the + right-hand side. Therefore, MaybeDeclarations should return a (synthesized) list of localTypes, and then + RightHandSide should distribute it down -} + +ATTR MaybeDeclarations [ | | localTypes : {M.Map NameWithRange TpScheme} ] + +SEM Module + | Module body . allTypeSchemes = M.fromList [ (NameWithRange name, scheme) | (name, scheme) <- M.assocs (typeEnvironment @lhs.importEnvironment) ] + +SEM Body + | Body loc . allTypeSchemes = @localTypes `M.union` @lhs.allTypeSchemes + . localTypes = makeLocalTypeEnv (@declarations.typeSignatures `M.union` @inferredTypes) @declarations.bindingGroups + +SEM MaybeDeclarations + | Just lhs . localTypes = makeLocalTypeEnv (@declarations.typeSignatures `M.union` @inferredTypes) @declarations.bindingGroups + | Nothing lhs . localTypes = M.empty + +SEM RightHandSide + | Expression loc . allTypeSchemes = @where.localTypes `M.union` @lhs.allTypeSchemes + | Guarded loc . allTypeSchemes = @where.localTypes `M.union` @lhs.allTypeSchemes + +SEM Expression + | Let loc . allTypeSchemes = @localTypes `M.union` @lhs.allTypeSchemes + . localTypes = makeLocalTypeEnv (@declarations.typeSignatures `M.union` @inferredTypes) @declarations.bindingGroups + +SEM Statement + | Let loc . allTypeSchemes = @localTypes `M.union` @lhs.allTypeSchemes + . localTypes = makeLocalTypeEnv (@declarations.typeSignatures `M.union` @inferredTypes) @declarations.bindingGroups + +SEM Qualifier + | Let loc . allTypeSchemes = @localTypes `M.union` @lhs.allTypeSchemes + . localTypes = makeLocalTypeEnv (@declarations.typeSignatures `M.union` @inferredTypes) @declarations.bindingGroups + +{ +makeLocalTypeEnv :: TypeEnvironment -> BindingGroups -> M.Map NameWithRange TpScheme +makeLocalTypeEnv local groups = + let (environment, _, _) = concatBindingGroups groups + names = M.keys environment + f x = maybe err id (find (==x) names) + err = internalError "TypeInferenceCollect.ag" "makeLocalTypeEnv" "could not find name" + in M.fromList [ (NameWithRange (f name), scheme) | (name, scheme) <- M.assocs local ] +} + +-- context for restricted pattern error +ATTR Declaration Declarations [ | | restrictedNames USE { ++ } { [] } : Names + simplePatNames USE { ++ } { [] } : Names ] + +SEM Declaration + | PatternBinding + (lhs.restrictedNames, lhs.simplePatNames) + = if isSimplePattern @pattern.self + then ([], @pattern.patVarNames) + else (@pattern.patVarNames, []) + +{ +isSimplePattern :: Pattern -> Bool +isSimplePattern pattern = + case pattern of + Pattern_Variable _ _ -> True + Pattern_Parenthesized _ p -> isSimplePattern p + _ -> False +} + +------------------------------------------- +-- Collecting Type Signatures + +ATTR Declaration Declarations [ | typeSignatures:TypeEnvironment | ] + +SEM Body | Body declarations . typeSignatures = M.empty +SEM Expression | Let declarations . typeSignatures = M.empty +SEM Statement | Let declarations . typeSignatures = M.empty +SEM Qualifier | Let declarations . typeSignatures = M.empty +SEM MaybeDeclarations | Just declarations . typeSignatures = M.empty + +SEM Declaration + | TypeSignature + lhs . typeSignatures = @lhs.typeSignatures `M.union` (M.fromList [ (name, @typeScheme) | name <- @names.self ]) + loc . typeScheme = makeTpSchemeFromType @type.self + +-------------------------------- +-- Derived instances + +ATTR Module -> Declaration [ | | collectInstances USE { ++ } { [] } : {[(Name, Instance)]} ] + +SEM Declaration + | Data + lhs . collectInstances = [ (cl, makeInstance (show cl) (length @simpletype.typevariables) (show @simpletype.name) ) + | cl <- @derivings.self + ] + +ATTR SimpleType [ | | name:Name typevariables:Names ] +SEM SimpleType + | SimpleType lhs . name = @name.self + . typevariables = @typevariables.self + +-------------------------------- +-- Chunks + +ATTR Expression Expressions MaybeExpression + Statement Statements Qualifier Qualifiers Alternative Alternatives + Declaration Declarations MaybeDeclarations Body + RightHandSide GuardedExpression GuardedExpressions + FunctionBinding FunctionBindings + RecordExpressionBinding RecordExpressionBindings + [ currentChunk:Int | uniqueChunk:Int | ] + +SEM Module + | Module body . currentChunk = 0 + . uniqueChunk = 1 + +SEM Body | Body lhs . uniqueChunk = @chunkNr -- from binding groups +SEM MaybeDeclarations | Just lhs . uniqueChunk = @chunkNr +SEM Expression | Let lhs . uniqueChunk = @chunkNr +SEM Statement | Let lhs . uniqueChunk = @chunkNr +SEM Qualifier | Let lhs . uniqueChunk = @chunkNr + +SEM Declaration + | FunctionBindings bindings . currentChunk = findCurrentChunk @bindings.name @lhs.inheritedBDG -- from binding groups + | PatternBinding righthandside . currentChunk = findCurrentChunk (head (M.keys @pattern.environment)) @lhs.inheritedBDG diff --git a/src/Helium/StaticAnalysis/Inferencers/TypeInferenceInfo.ag b/src/Helium/StaticAnalysis/Inferencers/TypeInferenceInfo.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/TypeInferenceInfo.ag @@ -0,0 +1,321 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Additional information (a local attribute) is provided for each type constraint. +-- +------------------------------------------------------------------------------- + +--------------------------------------------------------------------------------------- +-- Constraint Information : Body + +SEM Body | Body loc . cinfo = + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint, HasTrustFactor 10.0, IsImported name ] + +--------------------------------------------------------------------------------------- +-- Constraint Information : Declaration + +SEM Declaration | FunctionBindings loc . cinfo = + resultConstraint "function bindings (INTERNAL ERROR)" @parentTree + [ FolkloreConstraint, highlyTrusted, FuntionBindingEdge @bindings.numberOfPatterns ] + +SEM Declaration | PatternBinding loc . cinfo = + orphanConstraint 1 "right hand side" @parentTree + [] + +--------------------------------------------------------------------------------------- +-- Type Inferencing : FunctionBinding + +SEM FunctionBinding | FunctionBinding loc . cinfoLeft = + \num -> + orphanConstraint num "pattern of function binding" @parentTree + [ Unifier (head (ftv (@lhs.betasLeft !! num))) (ordinal True (num+1)++" pattern of function bindings", attribute @lhs.parentTree, "pattern") ] + +SEM FunctionBinding | FunctionBinding loc . cinfoBind = + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint + , makeUnifier name "function binding" @lefthandside.environment @parentTree + ] + +--------------------------------------------------------------------------------------- +-- Type Inferencing : RightHandSide + +-- RightHandSide.Expression +SEM RightHandSide | Expression loc . cinfo = + orphanConstraint 0 "right-hand side" @parentTree + [ Unifier (head (ftv @lhs.betaRight)) ("right-hand sides", attribute (skip_UHA_FB_RHS @lhs.parentTree), "right-hand side") ] + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Expression + +-- Expression.Literal +SEM Expression | Literal loc . cinfo = + resultConstraint "literal" @parentTree + [ FolkloreConstraint, HasTrustFactor 10.0 ] + +-- Expression.Constructor +SEM Expression | Constructor loc . cinfo = + resultConstraint "constructor" @parentTree + [ FolkloreConstraint, HasTrustFactor 10.0, IsImported @name.self ] + +-- Expression.NormalApplication +SEM Expression | NormalApplication loc . cinfo = + childConstraint 0 "application" @parentTree + [ ApplicationEdge False (map attribute @arguments.infoTrees) ] + +-- Expression.InfixApplication +SEM Expression | InfixApplication loc . operatorNr = length @leftExpression.infoTrees + loc . cinfoOperator = + childConstraint @operatorNr "infix application" @parentTree $ + if @leftExpression.section || @rightExpression.section + then [ HasTrustFactor 10.0 ] + else [ ApplicationEdge True (map attribute (@leftExpression.infoTrees ++ @rightExpression.infoTrees)) ] + +SEM Expression | InfixApplication loc . cinfoComplete = + specialConstraint "infix application (INTERNAL ERROR)" @parentTree + (self @localInfo, Nothing) + [ FolkloreConstraint, highlyTrusted ] + +SEM Expression | InfixApplication loc . cinfoLeftSection = + specialConstraint "left section" @parentTree + (self @localInfo, Nothing) + [ ] + +SEM Expression | InfixApplication loc . cinfoRightSection = + specialConstraint "right section" @parentTree + (self @localInfo, Nothing) + [ ] + +SEM Expression | InfixApplication loc . cinfoEmpty = + specialConstraint "infix application" @parentTree + (self @localInfo, Nothing) + [ FolkloreConstraint, HasTrustFactor 10.0 ] + +-- Expression.If +SEM Expression | If loc . cinfoGuard = + childConstraint 0 "conditional" @parentTree + [] + +SEM Expression | If loc . cinfoThen = + childConstraint 1 "then branch of conditional" @parentTree + [ Unifier (head (ftv @beta)) ("conditional", @localInfo, "then branch") ] + +SEM Expression | If loc . cinfoElse = + childConstraint 2 "else branch of conditional" @parentTree + [ Unifier (head (ftv @beta)) ("conditional", @localInfo, "else branch") ] + +-- Expression.Lambda +SEM Expression | Lambda loc . cinfoBind = + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint + , makeUnifier name "lambda abstraction" @patterns.environment @parentTree + ] + +SEM Expression | Lambda loc . cinfoType = + resultConstraint "lambda abstraction" @parentTree + [ FolkloreConstraint ] + +-- Expression.Case +SEM Expression | Case loc . cinfo = + childConstraint 0 "scrutinee of case expression" @parentTree + [ Unifier (head (ftv @beta')) ("case patterns", @localInfo, "scrutinee") ] + +-- Expression.Let +SEM Expression | Let loc . cinfoType = + resultConstraint "let expression (INTERNAL ERROR)" @thisTree + [ FolkloreConstraint, highlyTrusted ] + +-- Expression.Do +SEM Expression | Do loc . cinfo = + resultConstraint "do-expression" @parentTree + [ FolkloreConstraint ] + +-- Expression.List +SEM Expression | List loc . cinfoElem = + \elemNr -> + childConstraint elemNr "element of list" @parentTree $ + [ HasTrustFactor 10.0 | length @expressions.betas < 2 ] ++ + [ Unifier (head (ftv @beta')) ("list", @localInfo, ordinal False (elemNr+1) ++ " element") ] + +SEM Expression | List loc . cinfoResult = + resultConstraint "list" @parentTree + [ FolkloreConstraint ] + +-- Expression.Tuple +SEM Expression | Tuple loc . cinfo = + resultConstraint "tuple" @parentTree + [ FolkloreConstraint ] + +-- Expression.Comprehension +SEM Expression | Comprehension loc . cinfo = + resultConstraint "list comprehension" @parentTree + [ FolkloreConstraint ] + +-- Expression.Typed +SEM Expression | Typed loc . cinfoExpr = + childConstraint 0 "type annotation" @parentTree + [ TypeSignatureLocation (getTypeRange @type.self) ] + +SEM Expression | Typed loc . cinfoResult = + resultConstraint "type annotation" @parentTree + [ FolkloreConstraint ] {- ??? -} + +-- Expression.Enum +SEM Expression | Enum loc . cinfoFrom = + childConstraint 0 "enumeration" @parentTree + [] + +SEM Expression | Enum loc . cinfoThen = + childConstraint 1 "enumeration" @parentTree + [] + +SEM Expression | Enum loc . toChildNr = 1 + length @then.infoTrees + loc . cinfoTo = + childConstraint @toChildNr "enumeration" @parentTree + [] + +SEM Expression | Enum loc . cinfoResult = + resultConstraint "enumeration" @parentTree + [ FolkloreConstraint ] + +SEM Expression | Enum loc . cinfoPred = + resultConstraint "enumeration" @parentTree + [ ReductionErrorInfo (Predicate "Enum" @elementType) ] + +-- Expression.Negate +SEM Expression | Negate loc . cinfo = + specialConstraint "negation" @parentTree + (self @localInfo, Just $ nameToUHA_Expr (Name_Operator @range.self [] "-")) + [] + +SEM Expression | NegateFloat loc . cinfo = + specialConstraint "negation" @parentTree + (self @localInfo, Just $ nameToUHA_Expr (Name_Operator @range.self [] "-.")) + [] + +--------------------------------------------------------------------------------------- +-- Type Inferencing : GuardedExpression + +SEM GuardedExpression | GuardedExpression loc . cinfoGuard = + resultConstraint "guard" @guard.infoTree + [] + +SEM GuardedExpression | GuardedExpression loc . cinfoExpr = + resultConstraint "guarded expression" @expression.infoTree $ + [ HasTrustFactor 10.0 | @lhs.numberOfGuards < 2 ] ++ + [ Unifier (head (ftv @lhs.betaRight)) ("right-hand sides", attribute (skip_UHA_FB_RHS @lhs.parentTree), "right-hand side") ] + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Pattern + +-- Pattern.Literal +SEM Pattern | Literal loc . cinfo = + resultConstraint "literal pattern" @parentTree + [ FolkloreConstraint, HasTrustFactor 10.0 ] + +-- Pattern.Constructor +SEM Pattern | Constructor loc . cinfoConstructor = + resultConstraint "pattern constructor" @parentTree + [ FolkloreConstraint, HasTrustFactor 10.0 ] + +SEM Pattern | Constructor loc . cinfoApply = + specialConstraint "pattern application" @parentTree + (self @localInfo, Just $ nameToUHA_Pat @name.self) + [ ApplicationEdge False (map attribute @patterns.infoTrees) ] + +SEM Pattern | Constructor loc . cinfoEmpty = + resultConstraint "pattern constructor" @parentTree + [ HasTrustFactor 10.0 ] + +-- Pattern.InfixConstructor +SEM Pattern | InfixConstructor loc . cinfoConstructor = + variableConstraint "pattern constructor" (nameToUHA_Pat @constructorOperator.self) + [ FolkloreConstraint, HasTrustFactor 10.0 ] + +SEM Pattern | InfixConstructor loc . cinfoApply = + specialConstraint "infix pattern application" @parentTree + (self @localInfo, Just $ nameToUHA_Pat @constructorOperator.self) + [ ApplicationEdge True (map attribute [@leftPattern.infoTree, @rightPattern.infoTree]) ] + +-- Pattern.List +SEM Pattern | List loc . cinfoElem = + \elemNr -> + childConstraint elemNr "element of pattern list" @parentTree $ + [ HasTrustFactor 10.0 | length @patterns.constraintslist < 2 ] ++ + [ Unifier (head (ftv @beta')) ("pattern list", @localInfo, ordinal False (elemNr+1) ++ " element") ] + +SEM Pattern | List loc . cinfoResult = + resultConstraint "pattern list" @parentTree + [ FolkloreConstraint ] + +-- Pattern.Tuple +SEM Pattern | Tuple loc . cinfo = + resultConstraint "pattern tuple" @parentTree + [ FolkloreConstraint ] + +-- Pattern.Negate +SEM Pattern | Negate loc . cinfo = + resultConstraint "pattern negation" @parentTree + [ FolkloreConstraint ] + +-- Pattern.As +SEM Pattern | As loc . cinfo = + specialConstraint "as pattern" @parentTree + (self @localInfo, Just $ nameToUHA_Pat @name.self) + [] + +-- Pattern.NegateFloat +SEM Pattern | NegateFloat loc . cinfo = + resultConstraint "pattern negation" @parentTree + [ FolkloreConstraint ] + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Alternative + +SEM Alternative | Alternative loc . cinfoLeft = + resultConstraint "case pattern" @pattern.infoTree + [ Unifier (head (ftv @lhs.betaLeft)) ("case patterns", attribute @lhs.parentTree, "case pattern") ] + +SEM Alternative | Alternative loc . cinfoBind = + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint + , makeUnifier name "case alternative" @pattern.environment @lhs.parentTree + ] + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Statement + +SEM Statement | Expression loc . cinfo = + orphanConstraint 0 "generator" @parentTree + [] + +SEM Statement | Generator loc . cinfoResult = + childConstraint 1 "generator" @parentTree + [] + +SEM Statement | Generator loc . cinfoBind = + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint + , makeUnifier name "generator" @pattern.environment @parentTree + ] + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Qualifier + +SEM Qualifier | Guard loc . cinfo = + orphanConstraint 0 "boolean qualifier" @parentTree + [] + +SEM Qualifier | Generator loc . cinfoResult = + childConstraint 1 "generator" @parentTree + [] + +SEM Qualifier | Generator loc . cinfoBind = + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint + , makeUnifier name "generator" @pattern.environment @parentTree + ] diff --git a/src/Helium/StaticAnalysis/Inferencers/TypeInferenceOverloading.ag b/src/Helium/StaticAnalysis/Inferencers/TypeInferenceOverloading.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/TypeInferenceOverloading.ag @@ -0,0 +1,139 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Extra information for overloading (for code generation) +-- +----------------------------------------------------------------------------- + +ATTR Declarations Declaration Expressions Expression Statements Statement + Qualifiers Qualifier GuardedExpressions GuardedExpression + Alternatives Alternative FunctionBindings FunctionBinding + RightHandSide MaybeDeclarations MaybeExpression RecordExpressionBinding + RecordExpressionBindings Body + [ availablePredicates : Predicates + classEnvironment : ClassEnvironment + | dictionaryEnvironment : DictionaryEnvironment + | + ] + +SEM Module + | Module + -- return an empty dictionary environment for the non-overloading setting + lhs . dictionaryEnvironment = if Overloading `elem` @lhs.options + then @body.dictionaryEnvironment + else emptyDictionaryEnvironment + body . dictionaryEnvironment = emptyDictionaryEnvironment + . classEnvironment = @classEnv + . availablePredicates = [] + +SEM Declaration + + | FunctionBindings + loc . declPredicates = let scheme = M.findWithDefault err (NameWithRange @bindings.name) @lhs.allTypeSchemes + predicates = matchTypeWithScheme @lhs.orderedTypeSynonyms + (@lhs.substitution |-> @beta) + (@lhs.substitution |-> scheme) + err = internalError "TypeInferenceOverloading.ag" "n/a" "could not find type for function binding" + in expandPredicates @lhs.orderedTypeSynonyms predicates + bindings . availablePredicates = @declPredicates ++ @lhs.availablePredicates + lhs . dictionaryEnvironment = addForDeclaration @bindings.name @declPredicates @bindings.dictionaryEnvironment + + | PatternBinding + loc . declPredicates = case @pattern.self of + Pattern_Variable _ name -> + let scheme = M.findWithDefault err (NameWithRange name) @lhs.allTypeSchemes + predicates = matchTypeWithScheme @lhs.orderedTypeSynonyms + (@lhs.substitution |-> @betaRight) + (@lhs.substitution |-> scheme) + err = internalError "TypeInferenceOverloading.ag" "n/a" ("could not find type for pattern binding "++show name) + in Just (name, expandPredicates @lhs.orderedTypeSynonyms predicates) + _ -> Nothing + righthandside . availablePredicates = case @declPredicates of + Just (_, ps) -> ps ++ @lhs.availablePredicates + Nothing -> @lhs.availablePredicates + lhs . dictionaryEnvironment = case @declPredicates of + Just (n, ps) -> addForDeclaration n ps @righthandside.dictionaryEnvironment + Nothing -> @righthandside.dictionaryEnvironment + +SEM Expression + + | Variable lhs . dictionaryEnvironment = @newDEnv + loc . nameInScope = case filter (@name.self==) @lhs.namesInScope of + [name] -> NameWithRange name + _ -> internalError "TypeInferenceOverloading.ag" "n/a" "name not in scope" + . maybeInferredType = M.lookup @nameInScope @lhs.allTypeSchemes + . requiredDictionaries = -- if not in finitemap then this is bound by a monomorphic pattern variable + case @maybeInferredType of + Nothing -> [] + Just scheme -> getRequiredDictionaries + (getOrderedTypeSynonyms @lhs.importEnvironment) + (@lhs.substitution |-> @usedAsType) + (@lhs.substitution |-> scheme) + . newDEnv = resolveOverloading (@lhs.classEnvironment) + @name.self + (@lhs.substitution |-> @lhs.availablePredicates) + (@lhs.substitution |-> @requiredDictionaries) + @lhs.dictionaryEnvironment + . usedAsType = @lhs.substitution |-> @beta + + | Enum lhs . dictionaryEnvironment = @newDEnv + loc . localName = flip setNameRange @range.self $ + case (@then.section, @to.section) of + (False, False) -> enumFromThenToName + (False, True ) -> enumFromThenName + (True , False) -> enumFromToName + (True , True ) -> enumFromName + . requiredDictionaries = if @overloaded then @lhs.substitution |-> [Predicate "Enum" @elementType] else [] + . newDEnv = resolveOverloading (@lhs.classEnvironment) @localName + (@lhs.substitution |-> @lhs.availablePredicates) + (@lhs.substitution |-> @requiredDictionaries) + @to.dictionaryEnvironment + + + | Negate lhs . dictionaryEnvironment = @newDEnv + loc . localName = setNameRange intUnaryMinusName @range.self + . negateTypeScheme = case M.lookup @localName (typeEnvironment @lhs.importEnvironment) of + Just scheme -> scheme + Nothing -> internalError "TypeInferenceOverloading.ag" "n/a" "type of negate unknown" + . requiredDictionaries = getRequiredDictionaries + (getOrderedTypeSynonyms @lhs.importEnvironment) + (@lhs.substitution |-> @usedAsType) + (@lhs.substitution |-> @negateTypeScheme) + . usedAsType = @lhs.substitution |-> (@expression.beta .->. @beta) + . newDEnv = resolveOverloading (@lhs.classEnvironment) @localName + (@lhs.substitution |-> @lhs.availablePredicates) + (@lhs.substitution |-> @requiredDictionaries) + @expression.dictionaryEnvironment + +{ +getRequiredDictionaries :: OrderedTypeSynonyms -> Tp -> TpScheme -> Predicates +getRequiredDictionaries synonyms useType defType = + expandPredicates synonyms (matchTypeWithScheme synonyms useType defType) + +matchTypeWithScheme :: OrderedTypeSynonyms -> Tp -> TpScheme -> Predicates +matchTypeWithScheme synonyms tp scheme = + let (ips, itp) = split . snd . instantiate 0 . freezeFTV $ scheme + in case mguWithTypeSynonyms synonyms itp (freezeVariablesInType tp) of + Left _ -> internalError "TypeInferenceOverloading.ag" "matchTypeWithScheme" "no unification" + Right (_, sub) -> + let f (Predicate s typ) = Predicate s (unfreezeVariablesInType $ sub |-> typ) + in map f ips + +resolveOverloading :: ClassEnvironment -> Name -> Predicates -> Predicates -> + DictionaryEnvironment -> DictionaryEnvironment +resolveOverloading classEnv name availablePredicates predicates dEnv = + let maybeTrees = map (makeDictionaryTree classEnv availablePredicates) predicates + in if all isJust maybeTrees + then addForVariable name (map fromJust maybeTrees) dEnv + else internalError "TypeInferenceOverloading.ag" "resolveOverloading" ("cannot resolve overloading (" ++ show name ++ ")") + +expandPredicates :: OrderedTypeSynonyms -> Predicates -> Predicates +expandPredicates synonyms = map (expandPredicate synonyms) + +expandPredicate :: OrderedTypeSynonyms -> Predicate -> Predicate +expandPredicate (_, synonyms) (Predicate className tp) = Predicate className (expandType synonyms tp) +} diff --git a/src/Helium/StaticAnalysis/Inferencers/TypeInferenceRules.ag b/src/Helium/StaticAnalysis/Inferencers/TypeInferenceRules.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/TypeInferenceRules.ag @@ -0,0 +1,710 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Contains all the typing rules for the an UHA abstract syntax tree. +-- +----------------------------------------------------------------------------- + +---------------------------------------------------------------------------------------- +-- Type Inferencing : Module + +SEM Module + | Module + loc -- Solve the type constraints. + . (SolveResult betaUniqueAtTheEnd substitution typeschemeMap _ solveErrors) = @solveResult + . (solveResult, logEntries) = + (selectConstraintSolver @lhs.options @lhs.importEnvironment) + @classEnv + @orderedTypeSynonyms + @body.betaUnique + @body.constraints + + . orderedTypeSynonyms = getOrderedTypeSynonyms @lhs.importEnvironment + . classEnv = -- extend the set of imported instance declarations with the + -- derived instances + foldr (\(n, i) -> insertInstance (show n) i) + (createClassEnvironment @lhs.importEnvironment) + @body.collectInstances + . typeErrors = case makeTypeErrors @lhs.options @classEnv @orderedTypeSynonyms @substitution @solveErrors of + [] -> if NoOverloadingTypeCheck `elem` @lhs.options + then filter (\(TypeError _ ms _ _) -> not $ isInfixOf "Illegal overloaded type" $ show ms) @body.collectErrors + else @body.collectErrors + errs -> reverse errs + . warnings = @body.collectWarnings -- ++ @tooSpecificWarnings + . assumptions = let f xs = [ (n, @substitution |-> tp) | (n, tp) <- xs ] + in M.map f @body.assumptions + . initialScope = M.keys (typeEnvironment @lhs.importEnvironment) + . monos = map TVar @monomorphics + . monomorphics = ftv ( (M.elems $ valueConstructors @lhs.importEnvironment) + ++ (M.elems $ typeEnvironment @lhs.importEnvironment) + ) + + body . typeschemeMap = M.fromList (M.assocs @typeschemeMap) -- was a copy rule. + . betaUnique = if null @monomorphics + then 0 + else maximum @monomorphics + 1 + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Body + +ATTR Body + [ + monos : Monos + | betaUnique : Int + | assumptions : Assumptions + constraints : ConstraintSet + ] + +SEM Body + | Hole + lhs . assumptions = noAssumptions + . constraints = emptyTree + | Body + declarations . bindingGroups = [] + (loc.csetBinds,lhs.assumptions) = (typeEnvironment @lhs.importEnvironment .:::. @aset) @cinfo + loc . constraints = @csetBinds .>>. @cset + + (loc.aset, loc.cset, loc.inheritedBDG, loc.chunkNr, lhs.betaUnique, loc.implicitsFM) = + let inputBDG = (True, @lhs.currentChunk, @declarations.uniqueChunk, @lhs.monos, @declarations.typeSignatures, Nothing, @declarations.betaUnique) + in performBindingGroup inputBDG @declarations.bindingGroups + + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Declaration, Declarations, MaybeDeclarations + +ATTR Declaration Declarations MaybeDeclarations [ monos:Monos | betaUnique:Int | ] +ATTR Declaration Declarations [ inheritedBDG:InheritedBDG | bindingGroups:BindingGroups | ] +ATTR MaybeDeclarations [ | assumptions:Assumptions constraints:ConstraintSet | ] + +SEM Declaration + + | FunctionBindings + lhs . bindingGroups = @mybdggrp : @lhs.bindingGroups + bindings . betaUnique = @lhs.betaUnique + 2 + @bindings.numberOfPatterns + . monos = findMono @bindings.name @lhs.inheritedBDG ++ @lhs.monos + loc . beta = TVar @lhs.betaUnique + . betaRight = TVar (@lhs.betaUnique + 1) + . betasLeft = take @bindings.numberOfPatterns (map TVar [@lhs.betaUnique + 2..]) + . newcon = (@beta .==. foldr (.->.) @betaRight @betasLeft) @cinfo + . mybdggrp = ( M.singleton @bindings.name @beta + , @bindings.assumptions + , [ Node [ Phase (-1) [@newcon] + , Receive @lhs.betaUnique + , Node @bindings.constraintslist + ] + ] + ) + + | PatternBinding + lhs . bindingGroups = @mybdggrp : @lhs.bindingGroups + pattern . betaUnique = @lhs.betaUnique + 1 + righthandside . monos = findMono (head (M.keys @pattern.environment)) @lhs.inheritedBDG ++ @lhs.monos + loc . betaRight = TVar @lhs.betaUnique + . newcon = [ (@betaRight .==. @pattern.beta) @cinfo ] + . mybdggrp = ( @pattern.environment + , @righthandside.assumptions + , [ @newcon .>. + Node [ @pattern.constraints + , @righthandside.constraints + ] + ] + ) + +SEM MaybeDeclarations + | Just + declarations . bindingGroups = [] + (lhs.assumptions, lhs.constraints, loc.inheritedBDG, loc.chunkNr, lhs.betaUnique, loc.implicitsFM) = + let inputBDG = (False, @lhs.currentChunk, @declarations.uniqueChunk, @lhs.monos, @declarations.typeSignatures, mybdggroup, @declarations.betaUnique) + mybdggroup = Just (@lhs.assumptions, [@lhs.constraints]) + in performBindingGroup inputBDG @declarations.bindingGroups + +--------------------------------------------------------------------------------------- +-- Type Inferencing : FunctionBinding, FunctionBindings + +ATTR FunctionBinding FunctionBindings [ betasLeft:Tps betaRight:Tp monos:Monos | betaUnique:Int | assumptions:Assumptions numberOfPatterns:Int name:Name ] +ATTR FunctionBinding [ | | constraints:ConstraintSet] +ATTR FunctionBindings [ | | constraintslist:ConstraintSets] + +SEM FunctionBinding + + | Hole + loc . assumptions = noAssumptions + . constraints = emptyTree + . numberOfPatterns = 0 + . name = internalError "TypeInferencing.ag" "n/a" "FunctionBindings(2)" + | FunctionBinding + righthandside . monos = M.elems @lefthandside.environment ++ getMonos @csetBinds ++ @lhs.monos + loc . constraints = @csetBinds .>>. + Node [ @conLeft .<. @lefthandside.constraints + , @righthandside.constraints + ] + . conLeft = zipWith3 (\t1 t2 nr -> (t1 .==. t2) (@cinfoLeft nr)) @lefthandside.betas @lhs.betasLeft [0..] + (loc.csetBinds,lhs.assumptions) = (@lefthandside.environment .===. @righthandside.assumptions) @cinfoBind + +SEM FunctionBindings + + | Cons + lhs . assumptions = @hd.assumptions `combine` @tl.assumptions + . numberOfPatterns = @hd.numberOfPatterns + . name = @hd.name + . constraintslist = @hd.constraints : @tl.constraintslist + | Nil + lhs . assumptions = noAssumptions + . numberOfPatterns = internalError "TypeInferencing.ag" "n/a" "FunctionBindings(1)" + . name = internalError "TypeInferencing.ag" "n/a" "FunctionBindings(2)" + . constraintslist = [] + +--------------------------------------------------------------------------------------- +-- Type Inferencing : LeftHandSide, RightHandSide + +ATTR LeftHandSide RightHandSide [ monos:Monos | betaUnique:Int | constraints:ConstraintSet ] +ATTR LeftHandSide [ | | betas:Tps environment:PatternAssumptions numberOfPatterns:Int name:Name ] +ATTR RightHandSide [ betaRight:Tp | | assumptions:Assumptions ] + +SEM LeftHandSide + | Function + lhs . name = @name.self + loc . constraints = Node @patterns.constraintslist + + + | Infix + lhs . numberOfPatterns = 2 + . environment = @leftPattern.environment `M.union` @rightPattern.environment + . betas = [@leftPattern.beta,@rightPattern.beta] + . name = @operator.self + loc . constraints = Node [ @leftPattern.constraints + , @rightPattern.constraints + ] + + + | Parenthesized + lhs . numberOfPatterns = @lefthandside.numberOfPatterns + @patterns.numberOfPatterns + . environment = @lefthandside.environment `M.union` @patterns.environment + . betas = @lefthandside.betas ++ @patterns.betas + loc . constraints = Node ( @lefthandside.constraints : @patterns.constraintslist ) + +SEM RightHandSide + + | Expression + lhs . assumptions = @where.assumptions + . constraints = @where.constraints + where . assumptions = @expression.assumptions + . constraints = @newcon .>. @expression.constraints + loc . newcon = [ (@expression.beta .==. @lhs.betaRight) @cinfo ] + + + | Guarded + lhs . assumptions = @where.assumptions + . constraints = @where.constraints + guardedexpressions . numberOfGuards = length @guardedexpressions.constraintslist + where . assumptions = @guardedexpressions.assumptions + . constraints = Node @guardedexpressions.constraintslist + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Expression, Expressions, MaybeExpression + +ATTR Expression Expressions MaybeExpression [ monos:Monos | betaUnique:Int | assumptions:Assumptions ] +ATTR Expression [ | | beta:Tp constraints:ConstraintSet ] +ATTR Expressions [ | | betas:Tps constraintslist:ConstraintSets ] +ATTR MaybeExpression [ | | beta:Tp constraints:ConstraintSet section:Bool ] + +SEM Expression + + | Literal + lhs . betaUnique = @lhs.betaUnique + 1 + loc . assumptions = noAssumptions + . constraints = unitTree ((@literal.literalType .==. @beta) @cinfo) + . beta = TVar @lhs.betaUnique + + | Constructor + lhs . betaUnique = @lhs.betaUnique + 1 + loc . assumptions = noAssumptions + . constraints = listTree @newcon + . beta = TVar @lhs.betaUnique + . newcon = case M.lookup @name.self (valueConstructors @lhs.importEnvironment) of + Nothing -> [] + Just ctp -> [ (@beta .::. ctp) @cinfo ] + + | Variable + lhs . betaUnique = @lhs.betaUnique + 1 + loc . assumptions = @name.self `single` @beta + . constraints = Node [ Receive @lhs.betaUnique ] + . beta = TVar @lhs.betaUnique + + | Hole + lhs . betaUnique = @lhs.betaUnique + 1 + loc . assumptions = noAssumptions + . constraints = emptyTree + . beta = TVar @lhs.betaUnique + + | NormalApplication + function . betaUnique = @lhs.betaUnique + 1 + loc . assumptions = @function.assumptions `combine` @arguments.assumptions + . constraints = @newcon .>. + Node [ @function.constraints + , Node @arguments.constraintslist + ] + . beta = TVar @lhs.betaUnique + . newcon = [ (@function.beta .==. foldr (.->.) @beta @arguments.betas) @cinfo ] + + | InfixApplication + leftExpression . betaUnique = @lhs.betaUnique + 2 + loc . assumptions = @leftExpression.assumptions `combine` @operator.assumptions `combine` @rightExpression.assumptions + . constraints = @conTotal .>. + Node [ @operator.constraints + , @leftExpression.constraints + , @rightExpression.constraints + ] + . beta = TVar @lhs.betaUnique + . betaResOp = TVar (@lhs.betaUnique + 1) + . conOperator = (@operator.beta .==. @leftExpression.beta .->. @rightExpression.beta .->. @betaResOp) @cinfoOperator + . conTotal = case (@leftExpression.section,@rightExpression.section) of + (False,False) -> [ @conOperator, (@betaResOp .==. @beta) @cinfoComplete ] + (True ,True ) -> [ (@operator.beta .==. @beta) @cinfoEmpty ] + (False,True ) -> [ @conOperator, (@rightExpression.beta .->. @betaResOp .==. @beta) @cinfoRightSection ] + (True ,False) -> [ @conOperator, (@leftExpression.beta .->. @betaResOp .==. @beta) @cinfoLeftSection ] + + | If + guardExpression . betaUnique = @lhs.betaUnique + 1 + loc . assumptions = @guardExpression.assumptions `combine` @thenExpression.assumptions `combine` @elseExpression.assumptions + . constraints = Node [ @conGuard .<. @guardExpression.constraints + , @conThen .<. @thenExpression.constraints + , @conElse .<. @elseExpression.constraints + ] + . beta = TVar @lhs.betaUnique + . conGuard = [ (@guardExpression.beta .==. boolType) @cinfoGuard ] + . conThen = [ (@thenExpression.beta .==. @beta ) @cinfoThen ] + . conElse = [ (@elseExpression.beta .==. @beta ) @cinfoElse ] + + | Lambda + patterns . betaUnique = @lhs.betaUnique + 1 + expression . monos = M.elems @patterns.environment ++ getMonos @csetBinds ++ @lhs.monos + loc . constraints = @newcon .>. @csetBinds .>>. + Node [ Node @patterns.constraintslist + , @expression.constraints + ] + . beta = TVar @lhs.betaUnique + . newcon = [ (foldr (.->.) @expression.beta @patterns.betas .==. @beta) @cinfoType ] + (loc.csetBinds, loc.assumptions) = (@patterns.environment .===. @expression.assumptions) @cinfoBind + + | Case + expression . betaUnique = @lhs.betaUnique + 2 + alternatives . betaLeft = @beta' + . betaRight = @beta + loc . assumptions = @expression.assumptions `combine` @alternatives.assumptions + . constraints = Node [ @newcon .<. @expression.constraints + , Node @alternatives.constraintslist + ] + . beta = TVar @lhs.betaUnique + . beta' = TVar (@lhs.betaUnique + 1) + . newcon = [ (@expression.beta .==. @beta') @cinfo ] + + | Let + declarations . betaUnique = @lhs.betaUnique + 1 + . bindingGroups = [] + loc . constraints = [ (@expression.beta .==. @beta) @cinfoType ] .>. @cset + . beta = TVar @lhs.betaUnique + + (loc.assumptions, loc.cset, loc.inheritedBDG, loc.chunkNr, lhs.betaUnique, loc.implicitsFM) = + let inputBDG = (False, @lhs.currentChunk, @expression.uniqueChunk, @lhs.monos, @declarations.typeSignatures, mybdggroup, @expression.betaUnique) + mybdggroup = Just (@expression.assumptions, [@expression.constraints]) + in performBindingGroup inputBDG @declarations.bindingGroups + + | Do + lhs . constraints = Node [ @newcon .<. @statements.constraints ] + statements . betaUnique = @lhs.betaUnique + 1 + . generatorBeta = Nothing + . assumptions = noAssumptions + loc . assumptions = @statements.assumptions + . constraints = emptyTree + . beta = TVar @lhs.betaUnique + . newcon = case @statements.generatorBeta of + Nothing -> [] + Just b -> [ (ioType b .==. @beta) @cinfo ] + + | List + expressions . betaUnique = @lhs.betaUnique + 2 + loc . constraints = @newcon .>. + Node (zipWith3 @zipf @expressions.betas [0..] @expressions.constraintslist) + . beta = TVar @lhs.betaUnique + . beta' = TVar (@lhs.betaUnique + 1) + . newcon = [ (listType @beta' .==. @beta) @cinfoResult ] + . zipf = \tp childNr ctree -> [ (tp .==. @beta') (@cinfoElem childNr) ] .<. ctree + + | Tuple + expressions . betaUnique = @lhs.betaUnique + 1 + loc . constraints = @newcon .>. Node @expressions.constraintslist + . beta = TVar @lhs.betaUnique + . newcon = [ (tupleType @expressions.betas .==. @beta) @cinfo ] + + | Typed + expression . betaUnique = @lhs.betaUnique + 1 + loc . assumptions = @expression.assumptions + . constraints = @conResult .>. + Node [ @conExpr .<. @expression.constraints ] + . beta = TVar @lhs.betaUnique + . typeScheme = makeTpSchemeFromType @type.self + . conResult = [ (@beta .::. @typeScheme) @cinfoResult ] + . conExpr = [ (@expression.beta !::! @typeScheme) @lhs.monos @cinfoExpr ] + + | Comprehension + expression . betaUnique = @lhs.betaUnique + 1 + . monos = @qualifiers.monos + qualifiers . assumptions = @expression.assumptions + . constraints = @expression.constraints + . monos = @lhs.monos + loc . assumptions = @qualifiers.assumptions + . constraints = @newcon .>. Node [ @qualifiers.constraints ] + . beta = TVar @lhs.betaUnique + . newcon = [ (listType @expression.beta .==. @beta) @cinfo ] + + | Enum + from . betaUnique = @lhs.betaUnique + (if @overloaded then 2 else 1) + loc . assumptions = @from.assumptions `combine` @then.assumptions `combine` @to.assumptions + . constraints = (@conList ++ @conPredicate) .>. + Node [ @conFrom .<. @from.constraints + , @conThen .<. @then.constraints + , @conTo .<. @to.constraints + ] + . beta = TVar @lhs.betaUnique + . overloaded = case M.lookup enumFromName (typeEnvironment @lhs.importEnvironment) of + Just scheme -> isOverloaded scheme + Nothing -> False + . elementType = if @overloaded then TVar (@lhs.betaUnique + 1) else intType + . conPredicate = if @overloaded then [predicate (Predicate "Enum" @elementType) @cinfoPred] else [] + . conList = [ (listType @elementType .==. @beta) @cinfoResult ] + . conFrom = [ (@from.beta .==. @elementType) @cinfoFrom ] + . conThen = [ (@then.beta .==. @elementType) @cinfoThen ] + . conTo = [ (@to.beta .==. @elementType) @cinfoTo ] + + | Negate + expression . betaUnique = @lhs.betaUnique + 1 + loc . constraints = @newcon .>. Node [ @expression.constraints ] + . beta = TVar @lhs.betaUnique + . newcon = -- search for the type of 'negate' in the import envionment: otherwise use the default type. + let standard = makeScheme [] [Predicate "Num" (TVar 0)] (TVar 0 .->. TVar 0) + tpscheme = M.findWithDefault standard (nameFromString "negate") (typeEnvironment @lhs.importEnvironment) + in [ (@expression.beta .->. @beta .::. tpscheme) @cinfo] + +{- only for type inference without overloading -} + | NegateFloat + expression . betaUnique = @lhs.betaUnique + 1 + loc . constraints = @newcon .>. Node [ @expression.constraints ] + . beta = TVar @lhs.betaUnique + . newcon = [ (floatType .->. floatType .==. @expression.beta .->. @beta) @cinfo] + +SEM Expressions + + | Cons + lhs . betas = @hd.beta : @tl.betas + . assumptions = @hd.assumptions `combine` @tl.assumptions + . constraintslist = @hd.constraints : @tl.constraintslist + + | Nil + lhs . betas = [] + . assumptions = noAssumptions + . constraintslist = [] + +SEM MaybeExpression + + | Just + lhs . section = False + + | Nothing + lhs . section = True + . betaUnique = @lhs.betaUnique + 1 + . assumptions = noAssumptions + . constraints = emptyTree + loc . beta = TVar @lhs.betaUnique + +--------------------------------------------------------------------------------------- +-- Type Inferencing : GuardedExpression, GuardedExpressions + +ATTR GuardedExpressions GuardedExpression [ numberOfGuards:Int monos:Monos betaRight:Tp | betaUnique:Int | assumptions:Assumptions ] +ATTR GuardedExpressions [ | | constraintslist:ConstraintSets ] +ATTR GuardedExpression [ | | constraints:ConstraintSet ] + +SEM GuardedExpression + + | GuardedExpression + lhs . constraints = Node [ @newconGuard .<. @guard.constraints + , @newconExpr .<. @expression.constraints + ] + . assumptions = @guard.assumptions `combine` @expression.assumptions + loc . newconGuard = [ (@guard.beta .==. boolType) @cinfoGuard ] + . newconExpr = [ (@expression.beta .==. @lhs.betaRight) @cinfoExpr ] + +SEM GuardedExpressions + + | Cons + lhs . assumptions = @hd.assumptions `combine` @tl.assumptions + . constraintslist = @hd.constraints : @tl.constraintslist + + | Nil + lhs . assumptions = noAssumptions + . constraintslist = [] + + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Pattern + +ATTR Pattern Patterns [ monos:Monos | betaUnique:Int | environment:PatternAssumptions ] +ATTR Pattern [ | | beta:Tp constraints:ConstraintSet ] +ATTR Patterns [ | | betas:Tps constraintslist:ConstraintSets numberOfPatterns:Int ] + +SEM Pattern + | Hole + lhs . betaUnique = @lhs.betaUnique + 1 + . environment = noAssumptions + loc . constraints = emptyTree + . beta = TVar @lhs.betaUnique + + | Literal + lhs . betaUnique = @lhs.betaUnique + 1 + . environment = noAssumptions + loc . constraints = unitTree ((@literal.literalType .==. @beta) @cinfo) + . beta = TVar @lhs.betaUnique + + | Variable + lhs . betaUnique = @lhs.betaUnique + 1 + . environment = M.singleton @name.self @beta + loc . constraints = Receive @lhs.betaUnique + . beta = TVar @lhs.betaUnique + + | InfixConstructor + lhs . environment = @leftPattern.environment `M.union` @rightPattern.environment + leftPattern . betaUnique = @lhs.betaUnique + 2 + loc . constraints = @conApply .>. + Node [ listTree @conConstructor + , @leftPattern.constraints + , @rightPattern.constraints + ] + . beta = TVar @lhs.betaUnique + . betaCon = TVar (@lhs.betaUnique + 1) + . conApply = [ (@betaCon .==. @leftPattern.beta .->. @rightPattern.beta .->. @beta) @cinfoApply ] + . conConstructor = case M.lookup @constructorOperator.self (valueConstructors @lhs.importEnvironment) of + Nothing -> [] + Just ctp -> [ (@betaCon .::. ctp) @cinfoConstructor ] + + | Constructor + patterns . betaUnique = @lhs.betaUnique + 2 + loc . constraints = @conApply .>. + Node [ listTree @conConstructor + , Node @patterns.constraintslist + ] + . beta = TVar (@lhs.betaUnique) + . betaCon = TVar (@lhs.betaUnique + 1) + . conApply = [ (@betaCon .==. foldr (.->.) @beta @patterns.betas) + (if @patterns.numberOfPatterns == 0 then @cinfoEmpty else @cinfoApply) ] + . conConstructor = case M.lookup @name.self (valueConstructors @lhs.importEnvironment) of + Nothing -> [] + Just ctp -> [ (@betaCon .::. ctp) @cinfoConstructor ] + + | As + lhs . environment = M.insert @name.self @beta @pattern.environment + pattern . betaUnique = @lhs.betaUnique + 1 + loc . constraints = @newcon .>. + Node [ Receive @lhs.betaUnique + , @pattern.constraints + ] + . beta = TVar @lhs.betaUnique + . newcon = [ (@beta .==. @pattern.beta) @cinfo ] + + | Wildcard + lhs . betaUnique = @lhs.betaUnique + 1 + . environment = noAssumptions + loc . constraints = emptyTree + . beta = TVar @lhs.betaUnique + + | List + patterns . betaUnique = @lhs.betaUnique + 2 + loc . constraints = @newcon .>. + Node (zipWith3 @zipf @patterns.betas [0..] @patterns.constraintslist) + . beta = TVar @lhs.betaUnique + . beta' = TVar (@lhs.betaUnique + 1) + . newcon = [ (listType @beta' .==. @beta) @cinfoResult ] + . zipf = \tp elemNr ctree -> [ (tp .==. @beta') (@cinfoElem elemNr) ] .<. ctree + + | Tuple + patterns . betaUnique = @lhs.betaUnique + 1 + loc . constraints = @newcon .>. Node @patterns.constraintslist + . beta = TVar @lhs.betaUnique + . newcon = [ (tupleType @patterns.betas .==. @beta) @cinfo ] + + | Negate + lhs . betaUnique = @lhs.betaUnique + 1 + . environment = noAssumptions + loc . constraints = listTree @newcon + . beta = TVar @lhs.betaUnique + . newcon = -- The parser only accepts a literal after '-' in a Pattern + -- search for the type of 'negate' in the import envionment: otherwise use the default type. + let standard = makeScheme [] [Predicate "Num" (TVar 0)] (TVar 0 .->. TVar 0) + tpscheme = M.findWithDefault standard (nameFromString "negate") (typeEnvironment @lhs.importEnvironment) + in [ (@literal.literalType .->. @beta .::. tpscheme) @cinfo] + +{- only if type inferencing without overloading -} + | NegateFloat + lhs . betaUnique = @lhs.betaUnique + 1 + . environment = noAssumptions + loc . constraints = listTree @newcon + . beta = TVar @lhs.betaUnique + . newcon = -- The parser only accepts a literal after '-.' in a Pattern + [ (floatType .==. @beta) @cinfo ] + +SEM Patterns + + | Cons + lhs . betas = @hd.beta : @tl.betas + . environment = @hd.environment `M.union` @tl.environment + . numberOfPatterns = 1 + @tl.numberOfPatterns + . constraintslist = @hd.constraints : @tl.constraintslist + + | Nil + lhs . betas = [] + . environment = noAssumptions + . numberOfPatterns = 0 + . constraintslist = [] + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Alternative, Alternatives + +ATTR Alternative Alternatives [ betaLeft:Tp betaRight:Tp monos:Monos | betaUnique:Int | assumptions:Assumptions ] +ATTR Alternative [ | | constraints:ConstraintSet ] +ATTR Alternatives [ | | constraintslist:ConstraintSets ] + +SEM Alternative + + | Hole + lhs . assumptions = noAssumptions + loc . constraints = emptyTree + + | Alternative + righthandside . monos = M.elems @pattern.environment ++ getMonos @csetBinds ++ @lhs.monos + loc . constraints = @csetBinds .>>. + Node [ @conLeft .<. @pattern.constraints + , @righthandside.constraints + ] + . conLeft = [ (@pattern.beta .==. @lhs.betaLeft) @cinfoLeft ] + (loc.csetBinds,lhs.assumptions) = (@pattern.environment .===. @righthandside.assumptions) @cinfoBind + + | Empty + lhs . assumptions = noAssumptions + loc . constraints = emptyTree + +SEM Alternatives + + | Cons + lhs . assumptions = @hd.assumptions `combine` @tl.assumptions + . constraintslist = @hd.constraints : @tl.constraintslist + + | Nil + lhs . assumptions = noAssumptions + . constraintslist = [] + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Statement, Statements, Qualifier, Qualifiers + +ATTR Statement Statements Qualifier Qualifiers [ | assumptions:Assumptions betaUnique:Int constraints:ConstraintSet | ] +ATTR Statement Statements [ | generatorBeta:{Maybe Tp} | ] +ATTR Statement Qualifier Qualifiers [ | monos:Monos | ] +ATTR Statements [ monos:Monos | | ] + +SEM Statement + + | Expression + lhs . generatorBeta = Just @beta + . assumptions = @lhs.assumptions `combine` @expression.assumptions + . constraints = @locConstraints + expression . betaUnique = @lhs.betaUnique + 1 + loc . locConstraints = Node [ @newcon .<. @expression.constraints + , @lhs.constraints + ] + . beta = TVar @lhs.betaUnique + . newcon = [ (@expression.beta .==. ioType @beta) @cinfo ] + + | Let + lhs . generatorBeta = Nothing + declarations . bindingGroups = [] + (lhs.assumptions, lhs.constraints, loc.inheritedBDG, loc.chunkNr, lhs.betaUnique, loc.implicitsFM) = + let inputBDG = (False, @lhs.currentChunk, @declarations.uniqueChunk, @lhs.monos, @declarations.typeSignatures, mybdggroup, @declarations.betaUnique) + mybdggroup = Just (@lhs.assumptions, [@lhs.constraints]) + in performBindingGroup inputBDG @declarations.bindingGroups + + + + | Generator + lhs . generatorBeta = Nothing + . constraints = @locConstraints + . assumptions = @assumptions' `combine` @expression.assumptions + . monos = M.elems @pattern.environment ++ getMonos @csetBinds ++ @lhs.monos + loc . locConstraints = @newcon .>. @csetBinds .>>. + Node [ @pattern.constraints + , @expression.constraints + , @lhs.constraints + ] + . newcon = [ (@expression.beta .==. ioType @pattern.beta) @cinfoResult ] + . (csetBinds,assumptions') = (@pattern.environment .===. @lhs.assumptions) @cinfoBind + +SEM Statements + + | Cons + lhs . assumptions = @hd.assumptions + . constraints = @hd.constraints + hd . assumptions = @tl.assumptions + . constraints = @tl.constraints + tl . assumptions = @lhs.assumptions + . constraints = @lhs.constraints + +SEM Qualifier + + | Guard + lhs . assumptions = @lhs.assumptions `combine` @guard.assumptions + . constraints = @locConstraints + loc . locConstraints = Node [ @newcon .<. @guard.constraints + , @lhs.constraints + ] + . newcon = [ (@guard.beta .==. boolType) @cinfo ] + + | Let declarations . bindingGroups = [] + (lhs.assumptions, lhs.constraints, loc.inheritedBDG, loc.chunkNr, lhs.betaUnique, loc.implicitsFM) = + let inputBDG = (False, @lhs.currentChunk, @declarations.uniqueChunk, @lhs.monos, @declarations.typeSignatures, mybdggroup, @declarations.betaUnique) + mybdggroup = Just (@lhs.assumptions, [@lhs.constraints]) + in performBindingGroup inputBDG @declarations.bindingGroups + + + | Generator + lhs . assumptions = @assumptions' `combine` @expression.assumptions + . constraints = @locConstraints + . monos = M.elems @pattern.environment ++ getMonos @csetBinds ++ @lhs.monos + loc . locConstraints = @newcon .>. @csetBinds .>>. + Node [ @pattern.constraints + , @expression.constraints + , @lhs.constraints + ] + . (csetBinds,assumptions') = (@pattern.environment .===. @lhs.assumptions) @cinfoBind + . newcon = [ (@expression.beta .==. listType @pattern.beta) @cinfoResult ] + +SEM Qualifiers + + | Cons + lhs . assumptions = @hd.assumptions + . constraints = @hd.constraints + hd . assumptions = @tl.assumptions + . constraints = @tl.constraints + tl . assumptions = @lhs.assumptions + . constraints = @lhs.constraints + +--------------------------------------------------------------------------------------- +-- Type Inferencing : Literal + +ATTR Literal [ | | literalType:Tp ] + +SEM Literal + | Int lhs . literalType = intType + | Char lhs . literalType = charType + | String lhs . literalType = stringType + | Float lhs . literalType = floatType diff --git a/src/Helium/StaticAnalysis/Inferencers/TypeInferencing.ag b/src/Helium/StaticAnalysis/Inferencers/TypeInferencing.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/TypeInferencing.ag @@ -0,0 +1,120 @@ + +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Type inferencing. +-- +----------------------------------------------------------------------------- + +{ +typeInferencing :: [Option] -> ImportEnvironment -> Module + -> (IO (), DictionaryEnvironment, TypeEnvironment, TypeErrors, Warnings) +typeInferencing options importEnv module_ = + let res = wrap_Module (sem_Module module_) Inh_Module { + importEnvironment_Inh_Module = importEnv, + options_Inh_Module = options } + debugIO = putStrLn (show $ logEntries_Syn_Module res) + in (debugIO, dictionaryEnvironment_Syn_Module res, toplevelTypes_Syn_Module res, typeErrors_Syn_Module res, warnings_Syn_Module res) + +proximaTypeInferencing :: [Option] -> ImportEnvironment -> Module + -> (TypeErrors, Warnings, TypeEnvironment, [(Range, TpScheme)]) +proximaTypeInferencing options importEnv module_ = + let res = wrap_Module (sem_Module module_) Inh_Module { + importEnvironment_Inh_Module = importEnv, + options_Inh_Module = options } + localTypeSchemes = typeSchemesInInfoTree (substitutionFromResult $ solveResult_Syn_Module res) + (qualifiersFromResult $ solveResult_Syn_Module res) + (infoTree_Syn_Module res) + in (typeErrors_Syn_Module res, warnings_Syn_Module res, toplevelTypes_Syn_Module res, localTypeSchemes) +} + +------------------------------------------------------------------------------- +-- Attributes for type inferencing + +ATTR Module + [ importEnvironment : ImportEnvironment + options : {[Option]} + | + | assumptions : Assumptions + dictionaryEnvironment : DictionaryEnvironment + infoTree : InfoTree + logEntries : LogEntries + solveResult : {SolveResult ConstraintInfo} + toplevelTypes : TypeEnvironment + typeErrors : TypeErrors + warnings : Warnings + ] + +------------------------------------------------------------------------------- +-- Includes + +INCLUDE "TypeInferenceRules.ag" +INCLUDE "TypeInferenceOverloading.ag" +INCLUDE "TypeInferenceCollect.ag" +INCLUDE "TypeInferenceInfo.ag" +INCLUDE "LocalInfo.ag" +INCLUDE "GlobalInfo.ag" +INCLUDE "HeliumPartialSyntax.ag" +INCLUDE "Scope.ag" +INCLUDE "UHA_Syntax.ag" + +--- Type Inference Directives (may be turned off) +INCLUDE "TS_PatternMatching.ag" + +-- SEM Module | Module lhs . solveResult = @solveResult { debugFromResult = debugFromResult @solveResult +-- ++ "Inference Strategies:" +-- } -- ++ [ ] @body.matchIO } + +-- Pattern Match Warnings (may be turned off) +INCLUDE "PatternMatchWarnings.ag" +SEM Module + | Module lhs . warnings = @loc.warnings ++ @body.patternMatchWarnings + +------------------------------------------------------------------------------- +-- Imports + +imports { + +-- types +import Top.Types +import Helium.StaticAnalysis.Miscellaneous.TypeConversion + +-- error messages and warnings +import Helium.StaticAnalysis.Messages.Messages +import Helium.StaticAnalysis.Messages.TypeErrors +import Helium.StaticAnalysis.Messages.Warnings +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Helium.StaticAnalysis.Miscellaneous.DoublyLinkedTree +import Helium.StaticAnalysis.Miscellaneous.UHA_Source + +-- constraints and constraint trees +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints +import Top.Ordering.Tree + +-- constraint solving + +import Helium.StaticAnalysis.Inferencers.SelectConstraintSolver (selectConstraintSolver) +import Top.Solver (SolveResult(..), LogEntries) +import Helium.StaticAnalysis.Heuristics.HeuristicsInfo (makeUnifier, skip_UHA_FB_RHS) +import Helium.StaticAnalysis.Inferencers.BindingGroupAnalysis + + +-- UHA syntax +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Range + +-- other + +import Helium.Utils.Utils (internalError, hole) +import Helium.ModuleSystem.ImportEnvironment hiding (setTypeSynonyms) +import Helium.ModuleSystem.DictionaryEnvironment +import Helium.Main.Args + +-- standard +import qualified Data.Map as M +import Data.Maybe +} diff --git a/src/Helium/StaticAnalysis/Inferencers/TypeInferencing.hs b/src/Helium/StaticAnalysis/Inferencers/TypeInferencing.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Inferencers/TypeInferencing.hs @@ -0,0 +1,22284 @@ +{-# LANGUAGE Rank2Types, GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Helium.StaticAnalysis.Inferencers.TypeInferencing where + + +-- types +import Top.Types +import Helium.StaticAnalysis.Miscellaneous.TypeConversion + +-- error messages and warnings +import Helium.StaticAnalysis.Messages.Messages +import Helium.StaticAnalysis.Messages.TypeErrors +import Helium.StaticAnalysis.Messages.Warnings +import Helium.StaticAnalysis.Miscellaneous.ConstraintInfo +import Helium.StaticAnalysis.Miscellaneous.DoublyLinkedTree +import Helium.StaticAnalysis.Miscellaneous.UHA_Source + +-- constraints and constraint trees +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints +import Top.Ordering.Tree + +-- constraint solving + +import Helium.StaticAnalysis.Inferencers.SelectConstraintSolver (selectConstraintSolver) +import Top.Solver (SolveResult(..), LogEntries) +import Helium.StaticAnalysis.Heuristics.HeuristicsInfo (makeUnifier, skip_UHA_FB_RHS) +import Helium.StaticAnalysis.Inferencers.BindingGroupAnalysis + + +-- UHA syntax +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Range + +-- other + +import Helium.Utils.Utils (internalError, hole) +import Helium.ModuleSystem.ImportEnvironment hiding (setTypeSynonyms) +import Helium.ModuleSystem.DictionaryEnvironment +import Helium.Main.Args + +-- standard +import qualified Data.Map as M +import Data.Maybe + + + +import Data.List +import Helium.StaticAnalysis.Directives.Matchers +import Helium.StaticAnalysis.Directives.TS_Apply (applyTypingStrategy, matchInformation) +import Helium.StaticAnalysis.Directives.TS_CoreSyntax +import Helium.StaticAnalysis.Directives.TS_Attributes + + + +import Helium.Syntax.UHA_Utils +import Control.Monad.Identity (Identity) +import qualified Control.Monad.Identity + +typeInferencing :: [Option] -> ImportEnvironment -> Module + -> (IO (), DictionaryEnvironment, TypeEnvironment, TypeErrors, Warnings) +typeInferencing options importEnv module_ = + let res = wrap_Module (sem_Module module_) Inh_Module { + importEnvironment_Inh_Module = importEnv, + options_Inh_Module = options } + debugIO = putStrLn (show $ logEntries_Syn_Module res) + in (debugIO, dictionaryEnvironment_Syn_Module res, toplevelTypes_Syn_Module res, typeErrors_Syn_Module res, warnings_Syn_Module res) + +proximaTypeInferencing :: [Option] -> ImportEnvironment -> Module + -> (TypeErrors, Warnings, TypeEnvironment, [(Range, TpScheme)]) +proximaTypeInferencing options importEnv module_ = + let res = wrap_Module (sem_Module module_) Inh_Module { + importEnvironment_Inh_Module = importEnv, + options_Inh_Module = options } + localTypeSchemes = typeSchemesInInfoTree (substitutionFromResult $ solveResult_Syn_Module res) + (qualifiersFromResult $ solveResult_Syn_Module res) + (infoTree_Syn_Module res) + in (typeErrors_Syn_Module res, warnings_Syn_Module res, toplevelTypes_Syn_Module res, localTypeSchemes) + + +getRequiredDictionaries :: OrderedTypeSynonyms -> Tp -> TpScheme -> Predicates +getRequiredDictionaries synonyms useType defType = + expandPredicates synonyms (matchTypeWithScheme synonyms useType defType) + +matchTypeWithScheme :: OrderedTypeSynonyms -> Tp -> TpScheme -> Predicates +matchTypeWithScheme synonyms tp scheme = + let (ips, itp) = split . snd . instantiate 0 . freezeFTV $ scheme + in case mguWithTypeSynonyms synonyms itp (freezeVariablesInType tp) of + Left _ -> internalError "TypeInferenceOverloading.ag" "matchTypeWithScheme" "no unification" + Right (_, sub) -> + let f (Predicate s typ) = Predicate s (unfreezeVariablesInType $ sub |-> typ) + in map f ips + +resolveOverloading :: ClassEnvironment -> Name -> Predicates -> Predicates -> + DictionaryEnvironment -> DictionaryEnvironment +resolveOverloading classEnv name availablePredicates predicates dEnv = + let maybeTrees = map (makeDictionaryTree classEnv availablePredicates) predicates + in if all isJust maybeTrees + then addForVariable name (map fromJust maybeTrees) dEnv + else internalError "TypeInferenceOverloading.ag" "resolveOverloading" ("cannot resolve overloading (" ++ show name ++ ")") + +expandPredicates :: OrderedTypeSynonyms -> Predicates -> Predicates +expandPredicates synonyms = map (expandPredicate synonyms) + +expandPredicate :: OrderedTypeSynonyms -> Predicate -> Predicate +expandPredicate (_, synonyms) (Predicate className tp) = Predicate className (expandType synonyms tp) + + +findInferredTypes :: M.Map Int (Scheme Predicates) -> M.Map Name (Sigma Predicates) -> TypeEnvironment +findInferredTypes typeschemeMap = + let err = internalError "TypeInferenceCollect.ag" "findInferredTypes" "could not find type scheme variable" + f :: Sigma Predicates -> TpScheme + f (SigmaVar i) = M.findWithDefault err i typeschemeMap + f (SigmaScheme ts) = ts + in M.map f + +missingTypeSignature :: Bool -> Names -> TypeEnvironment -> Warnings +missingTypeSignature topLevel simplePats = + let -- for the moment, only missing type signature for top-level functions are reported (unless monomorphic). + makeWarning (name, scheme) = + let fromSimple = name `elem` simplePats && isOverloaded scheme + in [ NoTypeDef name scheme topLevel fromSimple | null (ftv scheme) && (topLevel || fromSimple) ] + in concatMap makeWarning . M.assocs + +restrictedNameErrors :: TypeEnvironment -> Names -> TypeErrors +restrictedNameErrors env = + let f name = case M.lookup name env of + Just scheme -> [ makeRestrictedButOverloadedError name scheme | isOverloaded scheme ] + Nothing -> [] + in concatMap f + + + +makeLocalTypeEnv :: TypeEnvironment -> BindingGroups -> M.Map NameWithRange TpScheme +makeLocalTypeEnv local groups = + let (environment, _, _) = concatBindingGroups groups + names = M.keys environment + f x = maybe err id (find (==x) names) + err = internalError "TypeInferenceCollect.ag" "makeLocalTypeEnv" "could not find name" + in M.fromList [ (NameWithRange (f name), scheme) | (name, scheme) <- M.assocs local ] + + +isSimplePattern :: Pattern -> Bool +isSimplePattern pattern = + case pattern of + Pattern_Variable _ _ -> True + Pattern_Parenthesized _ p -> isSimplePattern p + _ -> False + + +globalInfoError :: a +globalInfoError = internalError "GlobalInfo.ag" "n/a" "global info not available" + + +type ScopeInfo = ( [Names] -- duplicated variables + , [Name] -- unused variables + , [(Name, Name)] -- shadowed variables + ) + +changeOfScope :: Names -> Names -> Names -> (Names, Names, ScopeInfo) +changeOfScope names unboundNames namesInScope = + let (uniqueNames, duplicatedNames) = uniqueAppearance names + unusedNames = uniqueNames \\ unboundNames + shadowedNames = let f n = [ (n, n') | n' <- namesInScope, n == n' ] + in concatMap f uniqueNames + in ( uniqueNames ++ map head duplicatedNames ++ (namesInScope \\ names) + , unboundNames \\ names + , (duplicatedNames, unusedNames, shadowedNames) + ) + +uniqueAppearance :: Ord a => [a] -> ([a],[[a]]) +uniqueAppearance = Prelude.foldr myInsert ([],[]) . group . sort + where myInsert [x] (as,bs) = (x:as,bs) + myInsert xs (as,bs) = (as,xs:bs) + +nextUnique :: Num a => a -> (a, a) +nextUnique n = (n+1, n) + + +matchConverter0 :: [([String],())] -> () +matchConverter0 = const () + +matchConverter1 :: [([String],a)] -> [(a,[String])] +matchConverter1 = map (\(a,b) -> (b,a)) + +matchConverter2 :: [([String],(a,b))] -> ([(a,[String])],[(b,[String])]) +matchConverter2 = let localInsert (metas,(a,b)) (as,bs) = ((a,metas):as,(b,metas):bs) + in foldr localInsert ([],[]) + +matchConverter3 :: [([String],(a,b,c))] -> ([(a,[String])],[(b,[String])],[(c,[String])]) +matchConverter3 = let localInsert (metas,(a,b,c)) (as,bs,cs) = ((a,metas):as,(b,metas):bs,(c,metas):cs) + in foldr localInsert ([],[],[]) + +allMatch :: [Maybe [a]] -> Maybe [a] +allMatch = rec_ [] + where rec_ xs [] = Just xs + rec_ _ (Nothing:_) = Nothing + rec_ xs (Just ys:rest) = rec_ (ys ++ xs) rest + +data Match a = NoMatch | NonTerminalMatch a | MetaVariableMatch String + +instance Show (Match a) where + show (NoMatch) = "NoMatch" + show (NonTerminalMatch _) = "NonTerminal ??" + show (MetaVariableMatch s) = "MetaVariableMatch "++show s + +expressionVariableMatcher :: Expression -> Maybe String +expressionVariableMatcher expr = + case expr of + Expression_Variable _ name -> Just (show name) + _ -> Nothing + +match0 :: MetaVariableInfo -> Int -> (Expression -> Maybe ()) + -> [(Expression, [String])] + -> [((Expression, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> ((), [Maybe MetaVariableTable], ConstraintSet, Assumptions, Int, IO ()) +match0 = generalMatch expressionVariableMatcher matchConverter0 + +match1 :: MetaVariableInfo -> Int -> (Expression -> Maybe a) + -> [(Expression, [String])] + -> [((Expression, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> ([(a, [String])], [Maybe MetaVariableTable], + ConstraintSet, Assumptions, Int, IO ()) +match1 = generalMatch expressionVariableMatcher matchConverter1 + +match2 :: MetaVariableInfo -> Int -> (Expression -> Maybe (a, b)) + -> [(Expression, [String])] + -> [((Expression, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> (([(a, [String])], [(b, [String])]), [Maybe MetaVariableTable], + ConstraintSet, Assumptions, Int, IO ()) +match2 = generalMatch expressionVariableMatcher matchConverter2 + +match3 :: MetaVariableInfo -> Int -> (Expression -> Maybe (a, b, c)) + -> [(Expression, [String])] + -> [((Expression, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> (([(a, [String])], [(b, [String])], [(c, [String])]), + [Maybe MetaVariableTable], ConstraintSet, + Assumptions, Int, IO ()) +match3 = generalMatch expressionVariableMatcher matchConverter3 + +match0' :: (a -> Maybe ()) -> [(a, [String])] + -> [((a, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> ((), [Maybe MetaVariableTable], ConstraintSet, + Assumptions, Int, IO ()) +match0' = generalMatch noMatch matchConverter0 noMetaVariableInfo 0 + +match1' :: (a -> Maybe b) -> [(a, [String])] + -> [((a, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] -> + ([(b, [String])], [Maybe MetaVariableTable], + ConstraintSet, Assumptions, Int, IO ()) +match1' = generalMatch noMatch matchConverter1 noMetaVariableInfo 0 + +match2' :: (n -> Maybe (a, b)) -> [(n, [String])] + -> [((n, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> (([(a, [String])], [(b, [String])]), + [Maybe MetaVariableTable], ConstraintSet, Assumptions, Int, IO ()) +match2' = generalMatch noMatch matchConverter2 noMetaVariableInfo 0 + +matchOnlyVariable :: MetaVariableInfo -> [(Expression, [String])] -> [Maybe MetaVariableTable] +matchOnlyVariable infoTuple tryPats = + let ((),matches,_,_,_,_) = match0 infoTuple 0 noMatch tryPats [] [] + in matches + +noMatch :: a -> Maybe b +noMatch = const Nothing + +noMetaVariableInfo :: a +noMetaVariableInfo = internalError "PatternMatching.ag" "noMetaVariableInfo" "" + +generalMatch :: (nonTerminal -> Maybe String) + -> ([([String], childrenTuple)] -> childrenResult) + -> MetaVariableInfo + -> Int + -> (nonTerminal -> Maybe childrenTuple) + -> [(nonTerminal, [String])] + -> [((nonTerminal, [String]), Core_TypingStrategy)] + -> [[Maybe MetaVariableTable]] + -> ( childrenResult + , [Maybe MetaVariableTable] + , ConstraintSet + , Assumptions + , Int + , IO () + ) + +generalMatch exprVarMatcher converter metaInfo unique matcher tryPats allPats childrenResults = + let match (expr,metas) = + case exprVarMatcher expr of + Just s | s `elem` metas -> MetaVariableMatch s + _ -> case matcher expr of + Just x -> NonTerminalMatch (metas,x) + Nothing -> NoMatch + + (allPatterns, allStrategies) = unzip allPats + matchListTry = map match tryPats + matchListNew = map match allPatterns + + matchNTTry = [ x | NonTerminalMatch x <- matchListTry ] + matchNTNew = [ x | NonTerminalMatch x <- matchListNew ] + forChildren = converter (matchNTTry ++ matchNTNew) + + numberOfTry = length matchNTTry + (resultTry,resultNew) = unzip . map (splitAt numberOfTry) $ + if null childrenResults + then [repeat (Just [])] + else childrenResults + inspectMatch m (res, nts) = + case m of + NoMatch -> (Nothing:res, nts) + NonTerminalMatch _ -> (allMatch (head nts):res, tail nts) + MetaVariableMatch s -> (Just [(s, metaInfo)]:res, nts) -- !!! + + result = fst (foldr inspectMatch ([],reverse $ transpose resultTry) matchListTry) + complete = let (list,_) = foldr inspectMatch ([],reverse $ transpose resultNew) matchListNew + in [ (x, y) | (Just x, y) <- zip list allStrategies ] + + (assumptions, constraintSet, debugIO, newUnique) = + case complete of + + [] -> (getAssumptions metaInfo, getConstraintSet metaInfo, return (), unique) + + (childrenInfo, typingStrategy):_ + -> applyTypingStrategy typingStrategy metaInfo childrenInfo unique + in (forChildren, result, constraintSet, assumptions, newUnique, debugIO) + + +pmError :: String -> String -> a +pmError = internalError "PatternMatchWarnings" + + +expandTypeFromImportEnvironment :: ImportEnvironment -> Tp -> Tp +expandTypeFromImportEnvironment env = expandType (snd $ getOrderedTypeSynonyms env) + +patternMatchWarnings :: Substitution substitution + => ImportEnvironment -- the importenvironment + -> substitution -- substitution that contains the real types + -> Tp -- type of the patterns, unsubstituted + -> (Tp -> Tps) -- how should the type be interpreted? + -> [([PatternElement], Bool)] -- the patterns to be processed + -> Range -- range for the missing-warnings + -> Maybe Name -- maybe the name of the function + -> Bool -- should there be parentheses around the patterns? + -> [Warning] -- list of overlap-warnings for all of the patterns + -> String -- description of the place where the patterns are + -> String -- symbol after the patterns + -> [Warning] -- returns: list of warnings +patternMatchWarnings impenv sub tp strip elementss rng name parens unrwars place sym + = unreachablewarnings ++ missingwarnings + where + env = importEnvironmentToEnv impenv + exprtype = expandTypeFromImportEnvironment impenv $ sub |-> tp + types = strip exprtype + unreachables = unreachable impenv types $ map (\((a, _), c) -> (a, c)) $ filter (not.snd.fst) $ zip elementss [0..] + missing = complement impenv types $ map fst elementss + unreachablewarnings = map (unrwars !!) unreachables + missingwarnings + | null $ unMissing missing = [] + | otherwise = [MissingPatterns rng name exprtype (map (nicePattern parens env) $ missingList missing) place sym] + + + +---------- +-- misc -- +---------- + +-- lifted or +(|^|) :: (a -> Bool) -> (a -> Bool) -> a -> Bool +(|^|) f g x = f x || g x + +---------------------------------------------- +--- environments and substitution of types --- +---------------------------------------------- + +-- environment of constructors [(type, (constructorname, arguments))] +type Env = [(Tp, (Name, [Tp]))] + +importEnvironmentToEnv :: ImportEnvironment -> [(Tp, (Name, [Tp]))] +importEnvironmentToEnv = map rearrange . M.assocs . valueConstructors + +-- return the number of arguments of a constructor +-- tuples ar not in the Env so they require special treatment +nrOfArguments :: Env -> String -> Int +nrOfArguments env con | isTupleConstructor con = length con - 1 + | otherwise = case lookup (nameFromString con) $ map snd env + of Just args -> length args + Nothing -> 0 + +-- convert constructor to fit in an Env +rearrange :: (Name, TpScheme) -> (Tp, (Name, [Tp])) +rearrange (name, tpscheme) = let (args, res) = functionSpine $ unqualify $ unquantify tpscheme + in (res, (name, args)) + +-- get the constructors of a given type out of an Env +-- tuples ar not in the Env so they require special treatment +constructors :: ImportEnvironment -> Tp -> [(Name, [Tp])] +constructors _ (TVar _) = [] +constructors impenv tp | isTupleConstructor name = [tupleconstructor] + | otherwise = map expand $ concatMap (substitute tp) $ importEnvironmentToEnv impenv + where + name :: String + name = unTCon $ fst $ leftSpine tp + tupleconstructor :: (Name, [Tp]) + tupleconstructor = (nameFromString name, snd $ leftSpine tp) + unTCon :: Tp -> String + unTCon (TCon c) = c + unTCon tp' = pmError "unTCon" $ "type " ++ show tp' ++ " is not a TCon" + expand :: (Name, [Tp]) -> (Name, [Tp]) + expand (n, ts) = (n, map (expandTypeFromImportEnvironment impenv) ts) + +-- check of an entry in an Env is a constructor for the given type +-- if so, return this constructor, but with variables substituted for whatever is in the given type +-- the list returns zero or one elements +-- for example: substitute (Maybe Int) (Maybe a, (Just, [a])) will return [(Just, [Int])] +substitute :: Tp -> (Tp, (Name, [Tp])) -> [(Name, [Tp])] +substitute t1 (t2, (con, args)) = let (c1, ts1) = leftSpine t1 + (c2, ts2) = leftSpine t2 + sub = listToSubstitution $ zip (map unTVar ts2) ts1 + in if c1 == c2 + then [(con, map (sub |->) args)] + else [] + where + unTVar :: Tp -> Int + unTVar (TVar v) = v + unTVar _ = pmError "unTVar" "type is not a TVar" + +--------------------------------------------------------------- +--- datastructures and functions for the solution structure --- +--------------------------------------------------------------- + +-- a pattern is a list of patternelements +data PatternElement = WildcardElement | InfiniteElement String | FiniteElement String deriving Eq +isInfiniteElement :: PatternElement -> Bool +isInfiniteElement (InfiniteElement _) = True +isInfiniteElement _ = False +elementString :: PatternElement -> String +elementString (InfiniteElement s) = s +elementString ( FiniteElement s) = s +elementString _ = [] + +-- needed for Pattern_List and Literal_String occurences +listPat :: [[PatternElement]] -> [PatternElement] +listPat [] = [FiniteElement "[]"] +listPat (ps:pss) = FiniteElement ":" : ps ++ listPat pss + +stringPat :: String -> [PatternElement] +stringPat [] = [FiniteElement "[]"] +stringPat (c:cs) = FiniteElement ":" : InfiniteElement [c] : stringPat cs + +-- tree of missing patterns +data PatternsMissing = PatternsMissing [(PatternElement, PatternsMissing)] +unMissing :: PatternsMissing -> [(PatternElement, PatternsMissing)] +unMissing (PatternsMissing l) = l + +-- create a branch consisting of only wildcards +wildMissing :: Int -> PatternsMissing +wildMissing 0 = PatternsMissing [] +wildMissing n = PatternsMissing [(WildcardElement, wildMissing $ n - 1)] + +-- convert a missing patterns tree to a list of seperated missing patterns +missingList :: PatternsMissing -> [[PatternElement]] +missingList (PatternsMissing []) = [[]] +missingList (PatternsMissing [(d,t)]) = map (d:) $ missingList t +missingList (PatternsMissing (d:ds)) = (missingList $ PatternsMissing [d]) ++ (missingList $ PatternsMissing ds) + +------------------------------------------------------------------- +--- functions to create a UHA_Pattern out of a [PatternElement] --- +------------------------------------------------------------------- + +-- nice creates the actual pattern without parentheses +-- [Just, True, True, (,), Just, Nothing, False] -> [Just True, True, (Just Nothing, False)] +nicePattern :: Bool -> Env -> [PatternElement] -> [Pattern] +nicePattern b env = map (parensPattern b) . nice + where + nice :: [PatternElement] -> [Pattern] + nice [] = [] + nice (WildcardElement :ps) = Pattern_Wildcard noRange : nice ps + nice (InfiniteElement _ :_) = pmError "nicePattern" "InfiniteElement in pattern!" + nice (FiniteElement con:ps) = + let rest = nice ps + name = nameFromString con + n = nrOfArguments env con + in case name + of Name_Identifier _ _ _ -> Pattern_Constructor noRange name (take n rest) : drop n rest -- !!!Name + Name_Operator _ _ _ | con == ":" -> case head $ tail rest -- !!!Name + of Pattern_List _ pats -> Pattern_List noRange (head rest:pats) : (tail $ tail rest) + _ -> Pattern_InfixConstructor noRange (head rest) name (head $ tail rest) : (tail $ tail rest) + | otherwise -> Pattern_InfixConstructor noRange (head rest) name (head $ tail rest) : (tail $ tail rest) + Name_Special _ _ _ | isTupleConstructor con -> Pattern_Tuple noRange (take n rest) : drop n rest -- !!!Name + | con == "[]" -> Pattern_List noRange [] : rest + | otherwise -> Pattern_Constructor noRange name (take n rest) : drop n rest + +-- add parentheses to a pattern in the correct places +-- bool means: if needed, should there be parenthesis around the complete pattern? +parensPattern :: Bool -> Pattern -> Pattern +parensPattern b = if b then rap . par else fst . par + where + par :: Pattern -> (Pattern, Bool) -- Bool means: are parentheses needed around this pattern, shoud it be used in a more complex pattern + par p@(Pattern_Literal _ _ ) = (p, False) + par p@(Pattern_Variable _ _ ) = (p, False) + par (Pattern_Constructor r n ps ) = (Pattern_Constructor r n $ map (rap.par) ps, length ps > 0) + par (Pattern_Parenthesized _ p ) = par p + par (Pattern_InfixConstructor r l n k) = (Pattern_InfixConstructor r (rap $ par l) n (rap $ par k), True) + par (Pattern_List r ps ) = (Pattern_List r $ map (fst.par) ps, False) + par (Pattern_Tuple r ps ) = (Pattern_Tuple r $ map (fst.par) ps, False) + par (Pattern_Record _ _ _ ) = pmError "parensPattern" "Records are not supported" + par p@(Pattern_Negate _ _ ) = (p, True) + par p@(Pattern_NegateFloat _ _ ) = (p, True) + par (Pattern_As r n p ) = (Pattern_As r n (rap $ par p), False) + par p@(Pattern_Wildcard _ ) = (p, False) + par (Pattern_Irrefutable _ _ ) = pmError "parensPattern" "Irrefutable patterns are not supported" + par (Pattern_Successor _ _ _ ) = pmError "parensPattern" "Successors are not supported" + par (Pattern_Hole _ _ ) = error "not supported" + rap :: (Pattern, Bool) -> Pattern + rap (p, False) = p + rap (p, True ) = Pattern_Parenthesized noRange p + +-------------------------------------- +--- finally, the algorithm itself! --- +-------------------------------------- + +-- returns the tree of missing patterns for a given list of patterns +complement :: ImportEnvironment -> [Tp] -> [[PatternElement]] -> PatternsMissing +complement _ [] _ = PatternsMissing [] +complement _ _ ([]:_) = PatternsMissing [] +complement env (tp:tps) pss | null $ unMissing anyComplement = PatternsMissing [] + | all (((== WildcardElement) |^| isInfiniteElement).head) pss = anyComplement + | otherwise = finComplement + where + patComplement :: [[PatternElement]] -> PatternElement -> [Tp] -> PatternsMissing + patComplement [] current typs = PatternsMissing [(current, wildMissing $ length typs)] + patComplement patss current typs = case unMissing $ complement env typs $ map tail $ patss + of [] -> PatternsMissing [] + tegs -> PatternsMissing [(current, PatternsMissing tegs)] + anyComplement :: PatternsMissing + anyComplement = patComplement (filter ((== WildcardElement).head) pss) WildcardElement tps + conComplement :: (Name, [Tp]) -> PatternsMissing + conComplement (con, args) = patComplement ( filter ((== FiniteElement (getNameName con)).head) pss + ++ map (\ps -> FiniteElement (getNameName con) : replicate (length args) WildcardElement ++ tail ps) + (filter ((== WildcardElement).head) pss) + ) + (FiniteElement (getNameName con)) (args ++ tps) + finComplement :: PatternsMissing + finComplement = case constructors env tp + of [] -> wildMissing $ 1 + length tps + cons -> PatternsMissing $ concatMap (unMissing.conComplement) cons + +---------------------------- +--- unreachable patterns --- +---------------------------- + +-- complements the list of reachable patterns +unreachable :: ImportEnvironment -> [Tp] -> [([PatternElement], Int)] -> [Int] +unreachable env tps ps = let reach = reachable env tps ps + in filter (not . flip elem reach) (map snd ps) + +-- determines which patterns are reachable +-- possibly multiple occurances of indices +reachable :: ImportEnvironment -> [Tp] -> [([PatternElement], Int)] -> [Int] +reachable _ [] _ = pmError "reachable" "empty type list!" +reachable env (tp:tps) ps + | all ((== WildcardElement).head.fst) ps = conReachable ps + | otherwise = concat $ map (conReachable.conPats) $ stop cons + where + cons :: [PatternElement] + cons = thin $ map (head.fst) ps + conPats :: PatternElement -> [([PatternElement], Int)] + conPats con = map (\(es, i) -> (fill con es, i)) $ filter (((== con) |^| (== WildcardElement)).head.fst) ps + fill :: PatternElement -> [PatternElement] -> [PatternElement] + fill e@(FiniteElement c) (WildcardElement : es) = e : replicate (nrOfArguments (importEnvironmentToEnv env) c) WildcardElement ++ es + fill e (_ : es) = e : es + fill _ [] = error "Pattern match failure in StaticAnalysis.Inferencers.reachable" + stop :: [PatternElement] -> [PatternElement] + stop es | length (constructors env tp) > length es = FiniteElement "[*]" : es + | length (constructors env tp) == 0 = FiniteElement "[*]" : es + | otherwise = es + conReachable :: [([PatternElement], Int)] -> [Int] + conReachable [] = [] + conReachable pats + | null.tail.fst.head $ pats = [snd.head $ pats] + | otherwise = reachable env (arguments (elementString.head.fst.head $ pats) ++ tps) + $ map (\(es, i) -> (tail es, i)) pats + arguments :: String -> [Tp] + arguments c = maybe [] id $ lookup c $ map (\(n, typs) -> (getNameName n, typs)) $ constructors env tp + +-- remove double occurances and wildcards +thin :: [PatternElement] -> [PatternElement] +thin [] = [] +thin (WildcardElement : es) = thin es +thin (e : es) | elem e thines = thines + | otherwise = e : thines + where thines = thin es + +-- Alternative ------------------------------------------------- +-- wrapper +data Inh_Alternative = Inh_Alternative { allPatterns_Inh_Alternative :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_Alternative :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_Alternative :: (Predicates), betaLeft_Inh_Alternative :: (Tp), betaRight_Inh_Alternative :: (Tp), betaUnique_Inh_Alternative :: (Int), classEnvironment_Inh_Alternative :: (ClassEnvironment), collectErrors_Inh_Alternative :: (TypeErrors), collectWarnings_Inh_Alternative :: (Warnings), counter_Inh_Alternative :: (Int), currentChunk_Inh_Alternative :: (Int), dictionaryEnvironment_Inh_Alternative :: (DictionaryEnvironment), importEnvironment_Inh_Alternative :: (ImportEnvironment), matchIO_Inh_Alternative :: (IO ()), monos_Inh_Alternative :: (Monos), namesInScope_Inh_Alternative :: (Names), orderedTypeSynonyms_Inh_Alternative :: (OrderedTypeSynonyms), parentTree_Inh_Alternative :: (InfoTree), patternMatchWarnings_Inh_Alternative :: ([Warning]), substitution_Inh_Alternative :: (FixpointSubstitution), typeschemeMap_Inh_Alternative :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_Alternative :: (Int) } +data Syn_Alternative = Syn_Alternative { assumptions_Syn_Alternative :: (Assumptions), betaUnique_Syn_Alternative :: (Int), collectErrors_Syn_Alternative :: (TypeErrors), collectInstances_Syn_Alternative :: ([(Name, Instance)]), collectWarnings_Syn_Alternative :: (Warnings), constraints_Syn_Alternative :: (ConstraintSet), counter_Syn_Alternative :: (Int), dictionaryEnvironment_Syn_Alternative :: (DictionaryEnvironment), elements_Syn_Alternative :: ( ([PatternElement], Bool) ), infoTrees_Syn_Alternative :: (InfoTrees), matchIO_Syn_Alternative :: (IO ()), patternMatchWarnings_Syn_Alternative :: ([Warning]), self_Syn_Alternative :: (Alternative), unboundNames_Syn_Alternative :: (Names), uniqueChunk_Syn_Alternative :: (Int), unrwar_Syn_Alternative :: (Warning) } +{-# INLINABLE wrap_Alternative #-} +wrap_Alternative :: T_Alternative -> Inh_Alternative -> (Syn_Alternative ) +wrap_Alternative (T_Alternative act) (Inh_Alternative _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaLeft _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternative_vIn1 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaLeft _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk + (T_Alternative_vOut1 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOelements _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwar) <- return (inv_Alternative_s2 sem arg) + return (Syn_Alternative _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOelements _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwar) + ) + +-- cata +{-# NOINLINE sem_Alternative #-} +sem_Alternative :: Alternative -> T_Alternative +sem_Alternative ( Alternative_Hole range_ id_ ) = sem_Alternative_Hole ( sem_Range range_ ) id_ +sem_Alternative ( Alternative_Feedback range_ feedback_ alternative_ ) = sem_Alternative_Feedback ( sem_Range range_ ) feedback_ ( sem_Alternative alternative_ ) +sem_Alternative ( Alternative_Alternative range_ pattern_ righthandside_ ) = sem_Alternative_Alternative ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Alternative ( Alternative_Empty range_ ) = sem_Alternative_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Alternative = T_Alternative { + attach_T_Alternative :: Identity (T_Alternative_s2 ) + } +newtype T_Alternative_s2 = C_Alternative_s2 { + inv_Alternative_s2 :: (T_Alternative_v1 ) + } +data T_Alternative_s3 = C_Alternative_s3 +type T_Alternative_v1 = (T_Alternative_vIn1 ) -> (T_Alternative_vOut1 ) +data T_Alternative_vIn1 = T_Alternative_vIn1 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Tp) (Tp) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Int) +data T_Alternative_vOut1 = T_Alternative_vOut1 (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (DictionaryEnvironment) ( ([PatternElement], Bool) ) (InfoTrees) (IO ()) ([Warning]) (Alternative) (Names) (Int) (Warning) +{-# NOINLINE sem_Alternative_Hole #-} +sem_Alternative_Hole :: T_Range -> (Integer) -> T_Alternative +sem_Alternative_Hole arg_range_ arg_id_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaLeft _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule0 () + _constraints = rule1 () + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2 () + _lhsOelements :: ([PatternElement], Bool) + _lhsOelements = rule3 () + _lhsOunrwar :: Warning + _lhsOunrwar = rule4 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule5 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule6 () + _self = rule7 _rangeIself arg_id_ + _lhsOself :: Alternative + _lhsOself = rule8 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule9 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule10 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule11 _lhsIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule12 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule13 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule14 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule15 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule16 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule17 _lhsIuniqueChunk + __result_ = T_Alternative_vOut1 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOelements _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwar + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule0 #-} + rule0 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule1 #-} + rule1 = \ (_ :: ()) -> + emptyTree + {-# INLINE rule2 #-} + rule2 = \ (_ :: ()) -> + [] + {-# INLINE rule3 #-} + rule3 = \ (_ :: ()) -> + ([], False) + {-# INLINE rule4 #-} + rule4 = \ (_ :: ()) -> + pmError "Alternative_Empty.unrwar" "empty alternative" + {-# INLINE rule5 #-} + rule5 = \ (_ :: ()) -> + [] + {-# INLINE rule6 #-} + rule6 = \ (_ :: ()) -> + [] + {-# INLINE rule7 #-} + rule7 = \ ((_rangeIself) :: Range) id_ -> + Alternative_Hole _rangeIself id_ + {-# INLINE rule8 #-} + rule8 = \ _self -> + _self + {-# INLINE rule9 #-} + rule9 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule10 #-} + rule10 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule11 #-} + rule11 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule12 #-} + rule12 = \ _constraints -> + _constraints + {-# INLINE rule13 #-} + rule13 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule14 #-} + rule14 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule15 #-} + rule15 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule16 #-} + rule16 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule17 #-} + rule17 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Alternative_Feedback #-} +sem_Alternative_Feedback :: T_Range -> (String) -> T_Alternative -> T_Alternative +sem_Alternative_Feedback arg_range_ arg_feedback_ arg_alternative_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaLeft _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _alternativeX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_alternative_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Alternative_vOut1 _alternativeIassumptions _alternativeIbetaUnique _alternativeIcollectErrors _alternativeIcollectInstances _alternativeIcollectWarnings _alternativeIconstraints _alternativeIcounter _alternativeIdictionaryEnvironment _alternativeIelements _alternativeIinfoTrees _alternativeImatchIO _alternativeIpatternMatchWarnings _alternativeIself _alternativeIunboundNames _alternativeIuniqueChunk _alternativeIunrwar) = inv_Alternative_s2 _alternativeX2 (T_Alternative_vIn1 _alternativeOallPatterns _alternativeOallTypeSchemes _alternativeOavailablePredicates _alternativeObetaLeft _alternativeObetaRight _alternativeObetaUnique _alternativeOclassEnvironment _alternativeOcollectErrors _alternativeOcollectWarnings _alternativeOcounter _alternativeOcurrentChunk _alternativeOdictionaryEnvironment _alternativeOimportEnvironment _alternativeOmatchIO _alternativeOmonos _alternativeOnamesInScope _alternativeOorderedTypeSynonyms _alternativeOparentTree _alternativeOpatternMatchWarnings _alternativeOsubstitution _alternativeOtypeschemeMap _alternativeOuniqueChunk) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule18 _alternativeIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule19 _alternativeIunboundNames + _self = rule20 _alternativeIself _rangeIself arg_feedback_ + _lhsOself :: Alternative + _lhsOself = rule21 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule22 _alternativeIassumptions + _lhsObetaUnique :: Int + _lhsObetaUnique = rule23 _alternativeIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule24 _alternativeIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule25 _alternativeIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule26 _alternativeIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule27 _alternativeIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule28 _alternativeIdictionaryEnvironment + _lhsOelements :: ([PatternElement], Bool) + _lhsOelements = rule29 _alternativeIelements + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule30 _alternativeIinfoTrees + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule31 _alternativeImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule32 _alternativeIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule33 _alternativeIuniqueChunk + _lhsOunrwar :: Warning + _lhsOunrwar = rule34 _alternativeIunrwar + _alternativeOallPatterns = rule35 _lhsIallPatterns + _alternativeOallTypeSchemes = rule36 _lhsIallTypeSchemes + _alternativeOavailablePredicates = rule37 _lhsIavailablePredicates + _alternativeObetaLeft = rule38 _lhsIbetaLeft + _alternativeObetaRight = rule39 _lhsIbetaRight + _alternativeObetaUnique = rule40 _lhsIbetaUnique + _alternativeOclassEnvironment = rule41 _lhsIclassEnvironment + _alternativeOcollectErrors = rule42 _lhsIcollectErrors + _alternativeOcollectWarnings = rule43 _lhsIcollectWarnings + _alternativeOcounter = rule44 _lhsIcounter + _alternativeOcurrentChunk = rule45 _lhsIcurrentChunk + _alternativeOdictionaryEnvironment = rule46 _lhsIdictionaryEnvironment + _alternativeOimportEnvironment = rule47 _lhsIimportEnvironment + _alternativeOmatchIO = rule48 _lhsImatchIO + _alternativeOmonos = rule49 _lhsImonos + _alternativeOnamesInScope = rule50 _lhsInamesInScope + _alternativeOorderedTypeSynonyms = rule51 _lhsIorderedTypeSynonyms + _alternativeOparentTree = rule52 _lhsIparentTree + _alternativeOpatternMatchWarnings = rule53 _lhsIpatternMatchWarnings + _alternativeOsubstitution = rule54 _lhsIsubstitution + _alternativeOtypeschemeMap = rule55 _lhsItypeschemeMap + _alternativeOuniqueChunk = rule56 _lhsIuniqueChunk + __result_ = T_Alternative_vOut1 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOelements _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwar + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule18 #-} + rule18 = \ ((_alternativeIcollectInstances) :: [(Name, Instance)]) -> + _alternativeIcollectInstances + {-# INLINE rule19 #-} + rule19 = \ ((_alternativeIunboundNames) :: Names) -> + _alternativeIunboundNames + {-# INLINE rule20 #-} + rule20 = \ ((_alternativeIself) :: Alternative) ((_rangeIself) :: Range) feedback_ -> + Alternative_Feedback _rangeIself feedback_ _alternativeIself + {-# INLINE rule21 #-} + rule21 = \ _self -> + _self + {-# INLINE rule22 #-} + rule22 = \ ((_alternativeIassumptions) :: Assumptions) -> + _alternativeIassumptions + {-# INLINE rule23 #-} + rule23 = \ ((_alternativeIbetaUnique) :: Int) -> + _alternativeIbetaUnique + {-# INLINE rule24 #-} + rule24 = \ ((_alternativeIcollectErrors) :: TypeErrors) -> + _alternativeIcollectErrors + {-# INLINE rule25 #-} + rule25 = \ ((_alternativeIcollectWarnings) :: Warnings) -> + _alternativeIcollectWarnings + {-# INLINE rule26 #-} + rule26 = \ ((_alternativeIconstraints) :: ConstraintSet) -> + _alternativeIconstraints + {-# INLINE rule27 #-} + rule27 = \ ((_alternativeIcounter) :: Int) -> + _alternativeIcounter + {-# INLINE rule28 #-} + rule28 = \ ((_alternativeIdictionaryEnvironment) :: DictionaryEnvironment) -> + _alternativeIdictionaryEnvironment + {-# INLINE rule29 #-} + rule29 = \ ((_alternativeIelements) :: ([PatternElement], Bool) ) -> + _alternativeIelements + {-# INLINE rule30 #-} + rule30 = \ ((_alternativeIinfoTrees) :: InfoTrees) -> + _alternativeIinfoTrees + {-# INLINE rule31 #-} + rule31 = \ ((_alternativeImatchIO) :: IO ()) -> + _alternativeImatchIO + {-# INLINE rule32 #-} + rule32 = \ ((_alternativeIpatternMatchWarnings) :: [Warning]) -> + _alternativeIpatternMatchWarnings + {-# INLINE rule33 #-} + rule33 = \ ((_alternativeIuniqueChunk) :: Int) -> + _alternativeIuniqueChunk + {-# INLINE rule34 #-} + rule34 = \ ((_alternativeIunrwar) :: Warning) -> + _alternativeIunrwar + {-# INLINE rule35 #-} + rule35 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule36 #-} + rule36 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule37 #-} + rule37 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule38 #-} + rule38 = \ ((_lhsIbetaLeft) :: Tp) -> + _lhsIbetaLeft + {-# INLINE rule39 #-} + rule39 = \ ((_lhsIbetaRight) :: Tp) -> + _lhsIbetaRight + {-# INLINE rule40 #-} + rule40 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule41 #-} + rule41 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule42 #-} + rule42 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule43 #-} + rule43 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule44 #-} + rule44 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule45 #-} + rule45 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule46 #-} + rule46 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule47 #-} + rule47 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule48 #-} + rule48 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule49 #-} + rule49 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule50 #-} + rule50 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule51 #-} + rule51 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule52 #-} + rule52 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule53 #-} + rule53 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule54 #-} + rule54 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule55 #-} + rule55 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule56 #-} + rule56 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Alternative_Alternative #-} +sem_Alternative_Alternative :: T_Range -> T_Pattern -> T_RightHandSide -> T_Alternative +sem_Alternative_Alternative arg_range_ arg_pattern_ arg_righthandside_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaLeft _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIbeta _patternIbetaUnique _patternIconstraints _patternIcounter _patternIelements _patternIenvironment _patternIinfoTree _patternIpatVarNames _patternIpatternMatchWarnings _patternIself _patternIunboundNames) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternObetaUnique _patternOcounter _patternOimportEnvironment _patternOmonos _patternOnamesInScope _patternOparentTree _patternOpatternMatchWarnings) + (T_RightHandSide_vOut148 _righthandsideIassumptions _righthandsideIbetaUnique _righthandsideIcollectErrors _righthandsideIcollectInstances _righthandsideIcollectWarnings _righthandsideIconstraints _righthandsideIcounter _righthandsideIdictionaryEnvironment _righthandsideIfallthrough _righthandsideIinfoTree _righthandsideImatchIO _righthandsideIpatternMatchWarnings _righthandsideIself _righthandsideIunboundNames _righthandsideIuniqueChunk) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOallPatterns _righthandsideOallTypeSchemes _righthandsideOavailablePredicates _righthandsideObetaRight _righthandsideObetaUnique _righthandsideOclassEnvironment _righthandsideOcollectErrors _righthandsideOcollectWarnings _righthandsideOcounter _righthandsideOcurrentChunk _righthandsideOdictionaryEnvironment _righthandsideOimportEnvironment _righthandsideOmatchIO _righthandsideOmonos _righthandsideOnamesInScope _righthandsideOorderedTypeSynonyms _righthandsideOparentTree _righthandsideOpatternMatchWarnings _righthandsideOsubstitution _righthandsideOtypeschemeMap _righthandsideOuniqueChunk) + _righthandsideOmonos = rule57 _csetBinds _lhsImonos _patternIenvironment + _constraints = rule58 _conLeft _csetBinds _patternIconstraints _righthandsideIconstraints + _conLeft = rule59 _cinfoLeft _lhsIbetaLeft _patternIbeta + _lhsOassumptions :: Assumptions + (_csetBinds,_lhsOassumptions) = rule60 _cinfoBind _patternIenvironment _righthandsideIassumptions + _cinfoLeft = rule61 _lhsIbetaLeft _lhsIparentTree _patternIinfoTree + _cinfoBind = rule62 _lhsIparentTree _patternIenvironment + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule63 _patternIinfoTree _righthandsideIinfoTree + (_namesInScope,_unboundNames,_scopeInfo) = rule64 _lhsInamesInScope _patternIpatVarNames _righthandsideIunboundNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule65 _unboundNames + _lhsOelements :: ([PatternElement], Bool) + _lhsOelements = rule66 _patternIelements _righthandsideIfallthrough + _lhsOunrwar :: Warning + _lhsOunrwar = rule67 _patternIself _rangeIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule68 _righthandsideIcollectInstances + _self = rule69 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Alternative + _lhsOself = rule70 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule71 _righthandsideIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule72 _righthandsideIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule73 _righthandsideIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule74 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule75 _righthandsideIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule76 _righthandsideIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule77 _righthandsideImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule78 _righthandsideIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule79 _righthandsideIuniqueChunk + _patternObetaUnique = rule80 _lhsIbetaUnique + _patternOcounter = rule81 _lhsIcounter + _patternOimportEnvironment = rule82 _lhsIimportEnvironment + _patternOmonos = rule83 _lhsImonos + _patternOnamesInScope = rule84 _namesInScope + _patternOparentTree = rule85 _lhsIparentTree + _patternOpatternMatchWarnings = rule86 _lhsIpatternMatchWarnings + _righthandsideOallPatterns = rule87 _lhsIallPatterns + _righthandsideOallTypeSchemes = rule88 _lhsIallTypeSchemes + _righthandsideOavailablePredicates = rule89 _lhsIavailablePredicates + _righthandsideObetaRight = rule90 _lhsIbetaRight + _righthandsideObetaUnique = rule91 _patternIbetaUnique + _righthandsideOclassEnvironment = rule92 _lhsIclassEnvironment + _righthandsideOcollectErrors = rule93 _lhsIcollectErrors + _righthandsideOcollectWarnings = rule94 _lhsIcollectWarnings + _righthandsideOcounter = rule95 _patternIcounter + _righthandsideOcurrentChunk = rule96 _lhsIcurrentChunk + _righthandsideOdictionaryEnvironment = rule97 _lhsIdictionaryEnvironment + _righthandsideOimportEnvironment = rule98 _lhsIimportEnvironment + _righthandsideOmatchIO = rule99 _lhsImatchIO + _righthandsideOnamesInScope = rule100 _namesInScope + _righthandsideOorderedTypeSynonyms = rule101 _lhsIorderedTypeSynonyms + _righthandsideOparentTree = rule102 _lhsIparentTree + _righthandsideOpatternMatchWarnings = rule103 _patternIpatternMatchWarnings + _righthandsideOsubstitution = rule104 _lhsIsubstitution + _righthandsideOtypeschemeMap = rule105 _lhsItypeschemeMap + _righthandsideOuniqueChunk = rule106 _lhsIuniqueChunk + __result_ = T_Alternative_vOut1 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOelements _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwar + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule57 #-} + rule57 = \ _csetBinds ((_lhsImonos) :: Monos) ((_patternIenvironment) :: PatternAssumptions) -> + M.elems _patternIenvironment ++ getMonos _csetBinds ++ _lhsImonos + {-# INLINE rule58 #-} + rule58 = \ _conLeft _csetBinds ((_patternIconstraints) :: ConstraintSet) ((_righthandsideIconstraints) :: ConstraintSet) -> + _csetBinds .>>. + Node [ _conLeft .<. _patternIconstraints + , _righthandsideIconstraints + ] + {-# INLINE rule59 #-} + rule59 = \ _cinfoLeft ((_lhsIbetaLeft) :: Tp) ((_patternIbeta) :: Tp) -> + [ (_patternIbeta .==. _lhsIbetaLeft) _cinfoLeft ] + {-# INLINE rule60 #-} + rule60 = \ _cinfoBind ((_patternIenvironment) :: PatternAssumptions) ((_righthandsideIassumptions) :: Assumptions) -> + (_patternIenvironment .===. _righthandsideIassumptions) _cinfoBind + {-# INLINE rule61 #-} + rule61 = \ ((_lhsIbetaLeft) :: Tp) ((_lhsIparentTree) :: InfoTree) ((_patternIinfoTree) :: InfoTree) -> + resultConstraint "case pattern" _patternIinfoTree + [ Unifier (head (ftv _lhsIbetaLeft)) ("case patterns", attribute _lhsIparentTree, "case pattern") ] + {-# INLINE rule62 #-} + rule62 = \ ((_lhsIparentTree) :: InfoTree) ((_patternIenvironment) :: PatternAssumptions) -> + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint + , makeUnifier name "case alternative" _patternIenvironment _lhsIparentTree + ] + {-# INLINE rule63 #-} + rule63 = \ ((_patternIinfoTree) :: InfoTree) ((_righthandsideIinfoTree) :: InfoTree) -> + [_patternIinfoTree, _righthandsideIinfoTree] + {-# INLINE rule64 #-} + rule64 = \ ((_lhsInamesInScope) :: Names) ((_patternIpatVarNames) :: Names) ((_righthandsideIunboundNames) :: Names) -> + changeOfScope _patternIpatVarNames _righthandsideIunboundNames _lhsInamesInScope + {-# INLINE rule65 #-} + rule65 = \ _unboundNames -> + _unboundNames + {-# INLINE rule66 #-} + rule66 = \ ((_patternIelements) :: [PatternElement] ) ((_righthandsideIfallthrough) :: Bool) -> + (_patternIelements, _righthandsideIfallthrough) + {-# INLINE rule67 #-} + rule67 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + UnreachablePatternCase _rangeIself _patternIself + {-# INLINE rule68 #-} + rule68 = \ ((_righthandsideIcollectInstances) :: [(Name, Instance)]) -> + _righthandsideIcollectInstances + {-# INLINE rule69 #-} + rule69 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Alternative_Alternative _rangeIself _patternIself _righthandsideIself + {-# INLINE rule70 #-} + rule70 = \ _self -> + _self + {-# INLINE rule71 #-} + rule71 = \ ((_righthandsideIbetaUnique) :: Int) -> + _righthandsideIbetaUnique + {-# INLINE rule72 #-} + rule72 = \ ((_righthandsideIcollectErrors) :: TypeErrors) -> + _righthandsideIcollectErrors + {-# INLINE rule73 #-} + rule73 = \ ((_righthandsideIcollectWarnings) :: Warnings) -> + _righthandsideIcollectWarnings + {-# INLINE rule74 #-} + rule74 = \ _constraints -> + _constraints + {-# INLINE rule75 #-} + rule75 = \ ((_righthandsideIcounter) :: Int) -> + _righthandsideIcounter + {-# INLINE rule76 #-} + rule76 = \ ((_righthandsideIdictionaryEnvironment) :: DictionaryEnvironment) -> + _righthandsideIdictionaryEnvironment + {-# INLINE rule77 #-} + rule77 = \ ((_righthandsideImatchIO) :: IO ()) -> + _righthandsideImatchIO + {-# INLINE rule78 #-} + rule78 = \ ((_righthandsideIpatternMatchWarnings) :: [Warning]) -> + _righthandsideIpatternMatchWarnings + {-# INLINE rule79 #-} + rule79 = \ ((_righthandsideIuniqueChunk) :: Int) -> + _righthandsideIuniqueChunk + {-# INLINE rule80 #-} + rule80 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule81 #-} + rule81 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule82 #-} + rule82 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule83 #-} + rule83 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule84 #-} + rule84 = \ _namesInScope -> + _namesInScope + {-# INLINE rule85 #-} + rule85 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule86 #-} + rule86 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule87 #-} + rule87 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule88 #-} + rule88 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule89 #-} + rule89 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule90 #-} + rule90 = \ ((_lhsIbetaRight) :: Tp) -> + _lhsIbetaRight + {-# INLINE rule91 #-} + rule91 = \ ((_patternIbetaUnique) :: Int) -> + _patternIbetaUnique + {-# INLINE rule92 #-} + rule92 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule93 #-} + rule93 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule94 #-} + rule94 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule95 #-} + rule95 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule96 #-} + rule96 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule97 #-} + rule97 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule98 #-} + rule98 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule99 #-} + rule99 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule100 #-} + rule100 = \ _namesInScope -> + _namesInScope + {-# INLINE rule101 #-} + rule101 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule102 #-} + rule102 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule103 #-} + rule103 = \ ((_patternIpatternMatchWarnings) :: [Warning]) -> + _patternIpatternMatchWarnings + {-# INLINE rule104 #-} + rule104 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule105 #-} + rule105 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule106 #-} + rule106 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Alternative_Empty #-} +sem_Alternative_Empty :: T_Range -> T_Alternative +sem_Alternative_Empty arg_range_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaLeft _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule107 () + _constraints = rule108 () + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule109 () + _lhsOelements :: ([PatternElement], Bool) + _lhsOelements = rule110 () + _lhsOunrwar :: Warning + _lhsOunrwar = rule111 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule112 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule113 () + _self = rule114 _rangeIself + _lhsOself :: Alternative + _lhsOself = rule115 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule116 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule117 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule118 _lhsIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule119 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule120 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule121 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule122 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule123 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule124 _lhsIuniqueChunk + __result_ = T_Alternative_vOut1 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOelements _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwar + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule107 #-} + rule107 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule108 #-} + rule108 = \ (_ :: ()) -> + emptyTree + {-# INLINE rule109 #-} + rule109 = \ (_ :: ()) -> + [] + {-# INLINE rule110 #-} + rule110 = \ (_ :: ()) -> + ([], False) + {-# INLINE rule111 #-} + rule111 = \ (_ :: ()) -> + pmError "Alternative_Empty.unrwar" "empty alternative" + {-# INLINE rule112 #-} + rule112 = \ (_ :: ()) -> + [] + {-# INLINE rule113 #-} + rule113 = \ (_ :: ()) -> + [] + {-# INLINE rule114 #-} + rule114 = \ ((_rangeIself) :: Range) -> + Alternative_Empty _rangeIself + {-# INLINE rule115 #-} + rule115 = \ _self -> + _self + {-# INLINE rule116 #-} + rule116 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule117 #-} + rule117 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule118 #-} + rule118 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule119 #-} + rule119 = \ _constraints -> + _constraints + {-# INLINE rule120 #-} + rule120 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule121 #-} + rule121 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule122 #-} + rule122 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule123 #-} + rule123 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule124 #-} + rule124 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + +-- Alternatives ------------------------------------------------ +-- wrapper +data Inh_Alternatives = Inh_Alternatives { allPatterns_Inh_Alternatives :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_Alternatives :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_Alternatives :: (Predicates), betaLeft_Inh_Alternatives :: (Tp), betaRight_Inh_Alternatives :: (Tp), betaUnique_Inh_Alternatives :: (Int), classEnvironment_Inh_Alternatives :: (ClassEnvironment), collectErrors_Inh_Alternatives :: (TypeErrors), collectWarnings_Inh_Alternatives :: (Warnings), counter_Inh_Alternatives :: (Int), currentChunk_Inh_Alternatives :: (Int), dictionaryEnvironment_Inh_Alternatives :: (DictionaryEnvironment), importEnvironment_Inh_Alternatives :: (ImportEnvironment), matchIO_Inh_Alternatives :: (IO ()), monos_Inh_Alternatives :: (Monos), namesInScope_Inh_Alternatives :: (Names), orderedTypeSynonyms_Inh_Alternatives :: (OrderedTypeSynonyms), parentTree_Inh_Alternatives :: (InfoTree), patternMatchWarnings_Inh_Alternatives :: ([Warning]), substitution_Inh_Alternatives :: (FixpointSubstitution), typeschemeMap_Inh_Alternatives :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_Alternatives :: (Int) } +data Syn_Alternatives = Syn_Alternatives { assumptions_Syn_Alternatives :: (Assumptions), betaUnique_Syn_Alternatives :: (Int), collectErrors_Syn_Alternatives :: (TypeErrors), collectInstances_Syn_Alternatives :: ([(Name, Instance)]), collectWarnings_Syn_Alternatives :: (Warnings), constraintslist_Syn_Alternatives :: (ConstraintSets), counter_Syn_Alternatives :: (Int), dictionaryEnvironment_Syn_Alternatives :: (DictionaryEnvironment), elementss_Syn_Alternatives :: ([([PatternElement], Bool)]), infoTrees_Syn_Alternatives :: (InfoTrees), matchIO_Syn_Alternatives :: (IO ()), patternMatchWarnings_Syn_Alternatives :: ([Warning]), self_Syn_Alternatives :: (Alternatives), unboundNames_Syn_Alternatives :: (Names), uniqueChunk_Syn_Alternatives :: (Int), unrwars_Syn_Alternatives :: ([Warning]) } +{-# INLINABLE wrap_Alternatives #-} +wrap_Alternatives :: T_Alternatives -> Inh_Alternatives -> (Syn_Alternatives ) +wrap_Alternatives (T_Alternatives act) (Inh_Alternatives _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaLeft _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternatives_vIn4 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaLeft _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk + (T_Alternatives_vOut4 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOelementss _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwars) <- return (inv_Alternatives_s5 sem arg) + return (Syn_Alternatives _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOelementss _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwars) + ) + +-- cata +{-# NOINLINE sem_Alternatives #-} +sem_Alternatives :: Alternatives -> T_Alternatives +sem_Alternatives list = Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) + +-- semantic domain +newtype T_Alternatives = T_Alternatives { + attach_T_Alternatives :: Identity (T_Alternatives_s5 ) + } +newtype T_Alternatives_s5 = C_Alternatives_s5 { + inv_Alternatives_s5 :: (T_Alternatives_v4 ) + } +data T_Alternatives_s6 = C_Alternatives_s6 +type T_Alternatives_v4 = (T_Alternatives_vIn4 ) -> (T_Alternatives_vOut4 ) +data T_Alternatives_vIn4 = T_Alternatives_vIn4 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Tp) (Tp) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Int) +data T_Alternatives_vOut4 = T_Alternatives_vOut4 (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSets) (Int) (DictionaryEnvironment) ([([PatternElement], Bool)]) (InfoTrees) (IO ()) ([Warning]) (Alternatives) (Names) (Int) ([Warning]) +{-# NOINLINE sem_Alternatives_Cons #-} +sem_Alternatives_Cons :: T_Alternative -> T_Alternatives -> T_Alternatives +sem_Alternatives_Cons arg_hd_ arg_tl_ = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaLeft _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_hd_)) + _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_tl_)) + (T_Alternative_vOut1 _hdIassumptions _hdIbetaUnique _hdIcollectErrors _hdIcollectInstances _hdIcollectWarnings _hdIconstraints _hdIcounter _hdIdictionaryEnvironment _hdIelements _hdIinfoTrees _hdImatchIO _hdIpatternMatchWarnings _hdIself _hdIunboundNames _hdIuniqueChunk _hdIunrwar) = inv_Alternative_s2 _hdX2 (T_Alternative_vIn1 _hdOallPatterns _hdOallTypeSchemes _hdOavailablePredicates _hdObetaLeft _hdObetaRight _hdObetaUnique _hdOclassEnvironment _hdOcollectErrors _hdOcollectWarnings _hdOcounter _hdOcurrentChunk _hdOdictionaryEnvironment _hdOimportEnvironment _hdOmatchIO _hdOmonos _hdOnamesInScope _hdOorderedTypeSynonyms _hdOparentTree _hdOpatternMatchWarnings _hdOsubstitution _hdOtypeschemeMap _hdOuniqueChunk) + (T_Alternatives_vOut4 _tlIassumptions _tlIbetaUnique _tlIcollectErrors _tlIcollectInstances _tlIcollectWarnings _tlIconstraintslist _tlIcounter _tlIdictionaryEnvironment _tlIelementss _tlIinfoTrees _tlImatchIO _tlIpatternMatchWarnings _tlIself _tlIunboundNames _tlIuniqueChunk _tlIunrwars) = inv_Alternatives_s5 _tlX5 (T_Alternatives_vIn4 _tlOallPatterns _tlOallTypeSchemes _tlOavailablePredicates _tlObetaLeft _tlObetaRight _tlObetaUnique _tlOclassEnvironment _tlOcollectErrors _tlOcollectWarnings _tlOcounter _tlOcurrentChunk _tlOdictionaryEnvironment _tlOimportEnvironment _tlOmatchIO _tlOmonos _tlOnamesInScope _tlOorderedTypeSynonyms _tlOparentTree _tlOpatternMatchWarnings _tlOsubstitution _tlOtypeschemeMap _tlOuniqueChunk) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule125 _hdIassumptions _tlIassumptions + _lhsOconstraintslist :: ConstraintSets + _lhsOconstraintslist = rule126 _hdIconstraints _tlIconstraintslist + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule127 _hdIinfoTrees _tlIinfoTrees + _lhsOelementss :: [([PatternElement], Bool)] + _lhsOelementss = rule128 _hdIelements _tlIelementss + _lhsOunrwars :: [Warning] + _lhsOunrwars = rule129 _hdIunrwar _tlIunrwars + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule130 _hdIcollectInstances _tlIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule131 _hdIunboundNames _tlIunboundNames + _self = rule132 _hdIself _tlIself + _lhsOself :: Alternatives + _lhsOself = rule133 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule134 _tlIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule135 _tlIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule136 _tlIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule137 _tlIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule138 _tlIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule139 _tlImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule140 _tlIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule141 _tlIuniqueChunk + _hdOallPatterns = rule142 _lhsIallPatterns + _hdOallTypeSchemes = rule143 _lhsIallTypeSchemes + _hdOavailablePredicates = rule144 _lhsIavailablePredicates + _hdObetaLeft = rule145 _lhsIbetaLeft + _hdObetaRight = rule146 _lhsIbetaRight + _hdObetaUnique = rule147 _lhsIbetaUnique + _hdOclassEnvironment = rule148 _lhsIclassEnvironment + _hdOcollectErrors = rule149 _lhsIcollectErrors + _hdOcollectWarnings = rule150 _lhsIcollectWarnings + _hdOcounter = rule151 _lhsIcounter + _hdOcurrentChunk = rule152 _lhsIcurrentChunk + _hdOdictionaryEnvironment = rule153 _lhsIdictionaryEnvironment + _hdOimportEnvironment = rule154 _lhsIimportEnvironment + _hdOmatchIO = rule155 _lhsImatchIO + _hdOmonos = rule156 _lhsImonos + _hdOnamesInScope = rule157 _lhsInamesInScope + _hdOorderedTypeSynonyms = rule158 _lhsIorderedTypeSynonyms + _hdOparentTree = rule159 _lhsIparentTree + _hdOpatternMatchWarnings = rule160 _lhsIpatternMatchWarnings + _hdOsubstitution = rule161 _lhsIsubstitution + _hdOtypeschemeMap = rule162 _lhsItypeschemeMap + _hdOuniqueChunk = rule163 _lhsIuniqueChunk + _tlOallPatterns = rule164 _lhsIallPatterns + _tlOallTypeSchemes = rule165 _lhsIallTypeSchemes + _tlOavailablePredicates = rule166 _lhsIavailablePredicates + _tlObetaLeft = rule167 _lhsIbetaLeft + _tlObetaRight = rule168 _lhsIbetaRight + _tlObetaUnique = rule169 _hdIbetaUnique + _tlOclassEnvironment = rule170 _lhsIclassEnvironment + _tlOcollectErrors = rule171 _hdIcollectErrors + _tlOcollectWarnings = rule172 _hdIcollectWarnings + _tlOcounter = rule173 _hdIcounter + _tlOcurrentChunk = rule174 _lhsIcurrentChunk + _tlOdictionaryEnvironment = rule175 _hdIdictionaryEnvironment + _tlOimportEnvironment = rule176 _lhsIimportEnvironment + _tlOmatchIO = rule177 _hdImatchIO + _tlOmonos = rule178 _lhsImonos + _tlOnamesInScope = rule179 _lhsInamesInScope + _tlOorderedTypeSynonyms = rule180 _lhsIorderedTypeSynonyms + _tlOparentTree = rule181 _lhsIparentTree + _tlOpatternMatchWarnings = rule182 _hdIpatternMatchWarnings + _tlOsubstitution = rule183 _lhsIsubstitution + _tlOtypeschemeMap = rule184 _lhsItypeschemeMap + _tlOuniqueChunk = rule185 _hdIuniqueChunk + __result_ = T_Alternatives_vOut4 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOelementss _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwars + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule125 #-} + rule125 = \ ((_hdIassumptions) :: Assumptions) ((_tlIassumptions) :: Assumptions) -> + _hdIassumptions `combine` _tlIassumptions + {-# INLINE rule126 #-} + rule126 = \ ((_hdIconstraints) :: ConstraintSet) ((_tlIconstraintslist) :: ConstraintSets) -> + _hdIconstraints : _tlIconstraintslist + {-# INLINE rule127 #-} + rule127 = \ ((_hdIinfoTrees) :: InfoTrees) ((_tlIinfoTrees) :: InfoTrees) -> + _hdIinfoTrees ++ _tlIinfoTrees + {-# INLINE rule128 #-} + rule128 = \ ((_hdIelements) :: ([PatternElement], Bool) ) ((_tlIelementss) :: [([PatternElement], Bool)]) -> + _hdIelements : _tlIelementss + {-# INLINE rule129 #-} + rule129 = \ ((_hdIunrwar) :: Warning) ((_tlIunrwars) :: [Warning]) -> + _hdIunrwar : _tlIunrwars + {-# INLINE rule130 #-} + rule130 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule131 #-} + rule131 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule132 #-} + rule132 = \ ((_hdIself) :: Alternative) ((_tlIself) :: Alternatives) -> + (:) _hdIself _tlIself + {-# INLINE rule133 #-} + rule133 = \ _self -> + _self + {-# INLINE rule134 #-} + rule134 = \ ((_tlIbetaUnique) :: Int) -> + _tlIbetaUnique + {-# INLINE rule135 #-} + rule135 = \ ((_tlIcollectErrors) :: TypeErrors) -> + _tlIcollectErrors + {-# INLINE rule136 #-} + rule136 = \ ((_tlIcollectWarnings) :: Warnings) -> + _tlIcollectWarnings + {-# INLINE rule137 #-} + rule137 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule138 #-} + rule138 = \ ((_tlIdictionaryEnvironment) :: DictionaryEnvironment) -> + _tlIdictionaryEnvironment + {-# INLINE rule139 #-} + rule139 = \ ((_tlImatchIO) :: IO ()) -> + _tlImatchIO + {-# INLINE rule140 #-} + rule140 = \ ((_tlIpatternMatchWarnings) :: [Warning]) -> + _tlIpatternMatchWarnings + {-# INLINE rule141 #-} + rule141 = \ ((_tlIuniqueChunk) :: Int) -> + _tlIuniqueChunk + {-# INLINE rule142 #-} + rule142 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule143 #-} + rule143 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule144 #-} + rule144 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule145 #-} + rule145 = \ ((_lhsIbetaLeft) :: Tp) -> + _lhsIbetaLeft + {-# INLINE rule146 #-} + rule146 = \ ((_lhsIbetaRight) :: Tp) -> + _lhsIbetaRight + {-# INLINE rule147 #-} + rule147 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule148 #-} + rule148 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule149 #-} + rule149 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule150 #-} + rule150 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule151 #-} + rule151 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule152 #-} + rule152 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule153 #-} + rule153 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule154 #-} + rule154 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule155 #-} + rule155 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule156 #-} + rule156 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule157 #-} + rule157 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule158 #-} + rule158 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule159 #-} + rule159 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule160 #-} + rule160 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule161 #-} + rule161 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule162 #-} + rule162 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule163 #-} + rule163 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule164 #-} + rule164 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule165 #-} + rule165 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule166 #-} + rule166 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule167 #-} + rule167 = \ ((_lhsIbetaLeft) :: Tp) -> + _lhsIbetaLeft + {-# INLINE rule168 #-} + rule168 = \ ((_lhsIbetaRight) :: Tp) -> + _lhsIbetaRight + {-# INLINE rule169 #-} + rule169 = \ ((_hdIbetaUnique) :: Int) -> + _hdIbetaUnique + {-# INLINE rule170 #-} + rule170 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule171 #-} + rule171 = \ ((_hdIcollectErrors) :: TypeErrors) -> + _hdIcollectErrors + {-# INLINE rule172 #-} + rule172 = \ ((_hdIcollectWarnings) :: Warnings) -> + _hdIcollectWarnings + {-# INLINE rule173 #-} + rule173 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule174 #-} + rule174 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule175 #-} + rule175 = \ ((_hdIdictionaryEnvironment) :: DictionaryEnvironment) -> + _hdIdictionaryEnvironment + {-# INLINE rule176 #-} + rule176 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule177 #-} + rule177 = \ ((_hdImatchIO) :: IO ()) -> + _hdImatchIO + {-# INLINE rule178 #-} + rule178 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule179 #-} + rule179 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule180 #-} + rule180 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule181 #-} + rule181 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule182 #-} + rule182 = \ ((_hdIpatternMatchWarnings) :: [Warning]) -> + _hdIpatternMatchWarnings + {-# INLINE rule183 #-} + rule183 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule184 #-} + rule184 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule185 #-} + rule185 = \ ((_hdIuniqueChunk) :: Int) -> + _hdIuniqueChunk +{-# NOINLINE sem_Alternatives_Nil #-} +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaLeft _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule186 () + _lhsOconstraintslist :: ConstraintSets + _lhsOconstraintslist = rule187 () + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule188 () + _lhsOelementss :: [([PatternElement], Bool)] + _lhsOelementss = rule189 () + _lhsOunrwars :: [Warning] + _lhsOunrwars = rule190 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule191 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule192 () + _self = rule193 () + _lhsOself :: Alternatives + _lhsOself = rule194 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule195 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule196 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule197 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule198 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule199 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule200 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule201 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule202 _lhsIuniqueChunk + __result_ = T_Alternatives_vOut4 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOelementss _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwars + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule186 #-} + rule186 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule187 #-} + rule187 = \ (_ :: ()) -> + [] + {-# INLINE rule188 #-} + rule188 = \ (_ :: ()) -> + [] + {-# INLINE rule189 #-} + rule189 = \ (_ :: ()) -> + [] + {-# INLINE rule190 #-} + rule190 = \ (_ :: ()) -> + [] + {-# INLINE rule191 #-} + rule191 = \ (_ :: ()) -> + [] + {-# INLINE rule192 #-} + rule192 = \ (_ :: ()) -> + [] + {-# INLINE rule193 #-} + rule193 = \ (_ :: ()) -> + [] + {-# INLINE rule194 #-} + rule194 = \ _self -> + _self + {-# INLINE rule195 #-} + rule195 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule196 #-} + rule196 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule197 #-} + rule197 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule198 #-} + rule198 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule199 #-} + rule199 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule200 #-} + rule200 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule201 #-} + rule201 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule202 #-} + rule202 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + +-- AnnotatedType ----------------------------------------------- +-- wrapper +data Inh_AnnotatedType = Inh_AnnotatedType { counter_Inh_AnnotatedType :: (Int), namesInScope_Inh_AnnotatedType :: (Names) } +data Syn_AnnotatedType = Syn_AnnotatedType { counter_Syn_AnnotatedType :: (Int), self_Syn_AnnotatedType :: (AnnotatedType), unboundNames_Syn_AnnotatedType :: (Names) } +{-# INLINABLE wrap_AnnotatedType #-} +wrap_AnnotatedType :: T_AnnotatedType -> Inh_AnnotatedType -> (Syn_AnnotatedType ) +wrap_AnnotatedType (T_AnnotatedType act) (Inh_AnnotatedType _lhsIcounter _lhsInamesInScope) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedType_vIn7 _lhsIcounter _lhsInamesInScope + (T_AnnotatedType_vOut7 _lhsOcounter _lhsOself _lhsOunboundNames) <- return (inv_AnnotatedType_s8 sem arg) + return (Syn_AnnotatedType _lhsOcounter _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# INLINE sem_AnnotatedType #-} +sem_AnnotatedType :: AnnotatedType -> T_AnnotatedType +sem_AnnotatedType ( AnnotatedType_AnnotatedType range_ strict_ type_ ) = sem_AnnotatedType_AnnotatedType ( sem_Range range_ ) strict_ ( sem_Type type_ ) + +-- semantic domain +newtype T_AnnotatedType = T_AnnotatedType { + attach_T_AnnotatedType :: Identity (T_AnnotatedType_s8 ) + } +newtype T_AnnotatedType_s8 = C_AnnotatedType_s8 { + inv_AnnotatedType_s8 :: (T_AnnotatedType_v7 ) + } +data T_AnnotatedType_s9 = C_AnnotatedType_s9 +type T_AnnotatedType_v7 = (T_AnnotatedType_vIn7 ) -> (T_AnnotatedType_vOut7 ) +data T_AnnotatedType_vIn7 = T_AnnotatedType_vIn7 (Int) (Names) +data T_AnnotatedType_vOut7 = T_AnnotatedType_vOut7 (Int) (AnnotatedType) (Names) +{-# NOINLINE sem_AnnotatedType_AnnotatedType #-} +sem_AnnotatedType_AnnotatedType :: T_Range -> (Bool) -> T_Type -> T_AnnotatedType +sem_AnnotatedType_AnnotatedType arg_range_ arg_strict_ arg_type_ = T_AnnotatedType (return st8) where + {-# NOINLINE st8 #-} + st8 = let + v7 :: T_AnnotatedType_v7 + v7 = \ (T_AnnotatedType_vIn7 _lhsIcounter _lhsInamesInScope) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule203 () + _self = rule204 _rangeIself _typeIself arg_strict_ + _lhsOself :: AnnotatedType + _lhsOself = rule205 _self + _lhsOcounter :: Int + _lhsOcounter = rule206 _lhsIcounter + __result_ = T_AnnotatedType_vOut7 _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_AnnotatedType_s8 v7 + {-# INLINE rule203 #-} + rule203 = \ (_ :: ()) -> + [] + {-# INLINE rule204 #-} + rule204 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) strict_ -> + AnnotatedType_AnnotatedType _rangeIself strict_ _typeIself + {-# INLINE rule205 #-} + rule205 = \ _self -> + _self + {-# INLINE rule206 #-} + rule206 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + +-- AnnotatedTypes ---------------------------------------------- +-- wrapper +data Inh_AnnotatedTypes = Inh_AnnotatedTypes { counter_Inh_AnnotatedTypes :: (Int), namesInScope_Inh_AnnotatedTypes :: (Names) } +data Syn_AnnotatedTypes = Syn_AnnotatedTypes { counter_Syn_AnnotatedTypes :: (Int), self_Syn_AnnotatedTypes :: (AnnotatedTypes), unboundNames_Syn_AnnotatedTypes :: (Names) } +{-# INLINABLE wrap_AnnotatedTypes #-} +wrap_AnnotatedTypes :: T_AnnotatedTypes -> Inh_AnnotatedTypes -> (Syn_AnnotatedTypes ) +wrap_AnnotatedTypes (T_AnnotatedTypes act) (Inh_AnnotatedTypes _lhsIcounter _lhsInamesInScope) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedTypes_vIn10 _lhsIcounter _lhsInamesInScope + (T_AnnotatedTypes_vOut10 _lhsOcounter _lhsOself _lhsOunboundNames) <- return (inv_AnnotatedTypes_s11 sem arg) + return (Syn_AnnotatedTypes _lhsOcounter _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_AnnotatedTypes #-} +sem_AnnotatedTypes :: AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes list = Prelude.foldr sem_AnnotatedTypes_Cons sem_AnnotatedTypes_Nil (Prelude.map sem_AnnotatedType list) + +-- semantic domain +newtype T_AnnotatedTypes = T_AnnotatedTypes { + attach_T_AnnotatedTypes :: Identity (T_AnnotatedTypes_s11 ) + } +newtype T_AnnotatedTypes_s11 = C_AnnotatedTypes_s11 { + inv_AnnotatedTypes_s11 :: (T_AnnotatedTypes_v10 ) + } +data T_AnnotatedTypes_s12 = C_AnnotatedTypes_s12 +type T_AnnotatedTypes_v10 = (T_AnnotatedTypes_vIn10 ) -> (T_AnnotatedTypes_vOut10 ) +data T_AnnotatedTypes_vIn10 = T_AnnotatedTypes_vIn10 (Int) (Names) +data T_AnnotatedTypes_vOut10 = T_AnnotatedTypes_vOut10 (Int) (AnnotatedTypes) (Names) +{-# NOINLINE sem_AnnotatedTypes_Cons #-} +sem_AnnotatedTypes_Cons :: T_AnnotatedType -> T_AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes_Cons arg_hd_ arg_tl_ = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 _lhsIcounter _lhsInamesInScope) -> ( let + _hdX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_hd_)) + _tlX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_tl_)) + (T_AnnotatedType_vOut7 _hdIcounter _hdIself _hdIunboundNames) = inv_AnnotatedType_s8 _hdX8 (T_AnnotatedType_vIn7 _hdOcounter _hdOnamesInScope) + (T_AnnotatedTypes_vOut10 _tlIcounter _tlIself _tlIunboundNames) = inv_AnnotatedTypes_s11 _tlX11 (T_AnnotatedTypes_vIn10 _tlOcounter _tlOnamesInScope) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule207 _hdIunboundNames _tlIunboundNames + _self = rule208 _hdIself _tlIself + _lhsOself :: AnnotatedTypes + _lhsOself = rule209 _self + _lhsOcounter :: Int + _lhsOcounter = rule210 _tlIcounter + _hdOcounter = rule211 _lhsIcounter + _hdOnamesInScope = rule212 _lhsInamesInScope + _tlOcounter = rule213 _hdIcounter + _tlOnamesInScope = rule214 _lhsInamesInScope + __result_ = T_AnnotatedTypes_vOut10 _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule207 #-} + rule207 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule208 #-} + rule208 = \ ((_hdIself) :: AnnotatedType) ((_tlIself) :: AnnotatedTypes) -> + (:) _hdIself _tlIself + {-# INLINE rule209 #-} + rule209 = \ _self -> + _self + {-# INLINE rule210 #-} + rule210 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule211 #-} + rule211 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule212 #-} + rule212 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule213 #-} + rule213 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule214 #-} + rule214 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope +{-# NOINLINE sem_AnnotatedTypes_Nil #-} +sem_AnnotatedTypes_Nil :: T_AnnotatedTypes +sem_AnnotatedTypes_Nil = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 _lhsIcounter _lhsInamesInScope) -> ( let + _lhsOunboundNames :: Names + _lhsOunboundNames = rule215 () + _self = rule216 () + _lhsOself :: AnnotatedTypes + _lhsOself = rule217 _self + _lhsOcounter :: Int + _lhsOcounter = rule218 _lhsIcounter + __result_ = T_AnnotatedTypes_vOut10 _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule215 #-} + rule215 = \ (_ :: ()) -> + [] + {-# INLINE rule216 #-} + rule216 = \ (_ :: ()) -> + [] + {-# INLINE rule217 #-} + rule217 = \ _self -> + _self + {-# INLINE rule218 #-} + rule218 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + +-- Body -------------------------------------------------------- +-- wrapper +data Inh_Body = Inh_Body { allPatterns_Inh_Body :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_Body :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_Body :: (Predicates), betaUnique_Inh_Body :: (Int), classEnvironment_Inh_Body :: (ClassEnvironment), collectErrors_Inh_Body :: (TypeErrors), collectWarnings_Inh_Body :: (Warnings), counter_Inh_Body :: (Int), currentChunk_Inh_Body :: (Int), dictionaryEnvironment_Inh_Body :: (DictionaryEnvironment), importEnvironment_Inh_Body :: (ImportEnvironment), matchIO_Inh_Body :: (IO ()), monos_Inh_Body :: (Monos), namesInScope_Inh_Body :: (Names), orderedTypeSynonyms_Inh_Body :: (OrderedTypeSynonyms), patternMatchWarnings_Inh_Body :: ([Warning]), substitution_Inh_Body :: (FixpointSubstitution), typeschemeMap_Inh_Body :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_Body :: (Int) } +data Syn_Body = Syn_Body { assumptions_Syn_Body :: (Assumptions), betaUnique_Syn_Body :: (Int), collectErrors_Syn_Body :: (TypeErrors), collectInstances_Syn_Body :: ([(Name, Instance)]), collectWarnings_Syn_Body :: (Warnings), constraints_Syn_Body :: (ConstraintSet), counter_Syn_Body :: (Int), declVarNames_Syn_Body :: (Names), dictionaryEnvironment_Syn_Body :: (DictionaryEnvironment), infoTree_Syn_Body :: (InfoTree), matchIO_Syn_Body :: (IO ()), patternMatchWarnings_Syn_Body :: ([Warning]), self_Syn_Body :: (Body), toplevelTypes_Syn_Body :: (TypeEnvironment), unboundNames_Syn_Body :: (Names), uniqueChunk_Syn_Body :: (Int) } +{-# INLINABLE wrap_Body #-} +wrap_Body :: T_Body -> Inh_Body -> (Syn_Body ) +wrap_Body (T_Body act) (Inh_Body _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Body_vIn13 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk + (T_Body_vOut13 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOtoplevelTypes _lhsOunboundNames _lhsOuniqueChunk) <- return (inv_Body_s14 sem arg) + return (Syn_Body _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOtoplevelTypes _lhsOunboundNames _lhsOuniqueChunk) + ) + +-- cata +{-# NOINLINE sem_Body #-} +sem_Body :: Body -> T_Body +sem_Body ( Body_Hole range_ id_ ) = sem_Body_Hole ( sem_Range range_ ) id_ +sem_Body ( Body_Body range_ importdeclarations_ declarations_ ) = sem_Body_Body ( sem_Range range_ ) ( sem_ImportDeclarations importdeclarations_ ) ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_Body = T_Body { + attach_T_Body :: Identity (T_Body_s14 ) + } +newtype T_Body_s14 = C_Body_s14 { + inv_Body_s14 :: (T_Body_v13 ) + } +data T_Body_s15 = C_Body_s15 +type T_Body_v13 = (T_Body_vIn13 ) -> (T_Body_vOut13 ) +data T_Body_vIn13 = T_Body_vIn13 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Int) +data T_Body_vOut13 = T_Body_vOut13 (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (Names) (DictionaryEnvironment) (InfoTree) (IO ()) ([Warning]) (Body) (TypeEnvironment) (Names) (Int) +{-# NOINLINE sem_Body_Hole #-} +sem_Body_Hole :: T_Range -> (Integer) -> T_Body +sem_Body_Hole arg_range_ arg_id_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule219 () + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule220 () + _lhsOtoplevelTypes :: TypeEnvironment + _lhsOtoplevelTypes = rule221 () + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule222 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule223 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule224 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule225 () + _self = rule226 _rangeIself arg_id_ + _lhsOself :: Body + _lhsOself = rule227 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule228 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule229 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule230 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule231 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule232 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule233 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule234 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule235 _lhsIuniqueChunk + __result_ = T_Body_vOut13 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOtoplevelTypes _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule219 #-} + rule219 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule220 #-} + rule220 = \ (_ :: ()) -> + emptyTree + {-# INLINE rule221 #-} + rule221 = \ (_ :: ()) -> + M.empty + {-# INLINE rule222 #-} + rule222 = \ (_ :: ()) -> + root (LocalInfo {self = UHA_Decls [], assignedType = Nothing, monos = []}) [] + {-# INLINE rule223 #-} + rule223 = \ (_ :: ()) -> + [] + {-# INLINE rule224 #-} + rule224 = \ (_ :: ()) -> + [] + {-# INLINE rule225 #-} + rule225 = \ (_ :: ()) -> + [] + {-# INLINE rule226 #-} + rule226 = \ ((_rangeIself) :: Range) id_ -> + Body_Hole _rangeIself id_ + {-# INLINE rule227 #-} + rule227 = \ _self -> + _self + {-# INLINE rule228 #-} + rule228 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule229 #-} + rule229 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule230 #-} + rule230 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule231 #-} + rule231 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule232 #-} + rule232 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule233 #-} + rule233 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule234 #-} + rule234 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule235 #-} + rule235 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Body_Body #-} +sem_Body_Body :: T_Range -> T_ImportDeclarations -> T_Declarations -> T_Body +sem_Body_Body arg_range_ arg_importdeclarations_ arg_declarations_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importdeclarationsX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_importdeclarations_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ImportDeclarations_vOut73 _importdeclarationsIself) = inv_ImportDeclarations_s74 _importdeclarationsX74 (T_ImportDeclarations_vIn73 ) + (T_Declarations_vOut31 _declarationsIbetaUnique _declarationsIbindingGroups _declarationsIcollectErrors _declarationsIcollectInstances _declarationsIcollectWarnings _declarationsIcounter _declarationsIdeclVarNames _declarationsIdictionaryEnvironment _declarationsIinfoTrees _declarationsImatchIO _declarationsIpatternMatchWarnings _declarationsIrestrictedNames _declarationsIself _declarationsIsimplePatNames _declarationsItypeSignatures _declarationsIunboundNames _declarationsIuniqueChunk) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOallPatterns _declarationsOallTypeSchemes _declarationsOavailablePredicates _declarationsObetaUnique _declarationsObindingGroups _declarationsOclassEnvironment _declarationsOcollectErrors _declarationsOcollectWarnings _declarationsOcounter _declarationsOcurrentChunk _declarationsOdictionaryEnvironment _declarationsOimportEnvironment _declarationsOinheritedBDG _declarationsOmatchIO _declarationsOmonos _declarationsOnamesInScope _declarationsOorderedTypeSynonyms _declarationsOparentTree _declarationsOpatternMatchWarnings _declarationsOsubstitution _declarationsOtypeSignatures _declarationsOtypeschemeMap _declarationsOuniqueChunk) + _declarationsObindingGroups = rule236 () + _lhsOassumptions :: Assumptions + (_csetBinds,_lhsOassumptions) = rule237 _aset _cinfo _lhsIimportEnvironment + _constraints = rule238 _cset _csetBinds + _lhsObetaUnique :: Int + (_aset,_cset,_inheritedBDG,_chunkNr,_lhsObetaUnique,_implicitsFM) = rule239 _declarationsIbetaUnique _declarationsIbindingGroups _declarationsItypeSignatures _declarationsIuniqueChunk _lhsIcurrentChunk _lhsImonos + _inferredTypes = rule240 _implicitsFM _lhsItypeschemeMap + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule241 _declarationsIcollectWarnings _declarationsIsimplePatNames _inferredTypes + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule242 _declarationsIcollectErrors _declarationsIrestrictedNames _inferredTypes + _lhsOtoplevelTypes :: TypeEnvironment + _lhsOtoplevelTypes = rule243 _declarationsItypeSignatures _inferredTypes + _allTypeSchemes = rule244 _lhsIallTypeSchemes _localTypes + _localTypes = rule245 _declarationsIbindingGroups _declarationsItypeSignatures _inferredTypes + _declarationsOtypeSignatures = rule246 () + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule247 _chunkNr + _cinfo = rule248 () + _declInfo = rule249 _declarationsIself _lhsImonos + _parentTree = rule250 _declInfo _declarationsIinfoTrees + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule251 _parentTree + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule252 _declarationsIcollectInstances + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule253 _declarationsIdeclVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule254 _declarationsIunboundNames + _self = rule255 _declarationsIself _importdeclarationsIself _rangeIself + _lhsOself :: Body + _lhsOself = rule256 _self + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule257 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule258 _declarationsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule259 _declarationsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule260 _declarationsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule261 _declarationsIpatternMatchWarnings + _declarationsOallPatterns = rule262 _lhsIallPatterns + _declarationsOallTypeSchemes = rule263 _allTypeSchemes + _declarationsOavailablePredicates = rule264 _lhsIavailablePredicates + _declarationsObetaUnique = rule265 _lhsIbetaUnique + _declarationsOclassEnvironment = rule266 _lhsIclassEnvironment + _declarationsOcollectErrors = rule267 _lhsIcollectErrors + _declarationsOcollectWarnings = rule268 _lhsIcollectWarnings + _declarationsOcounter = rule269 _lhsIcounter + _declarationsOcurrentChunk = rule270 _lhsIcurrentChunk + _declarationsOdictionaryEnvironment = rule271 _lhsIdictionaryEnvironment + _declarationsOimportEnvironment = rule272 _lhsIimportEnvironment + _declarationsOinheritedBDG = rule273 _inheritedBDG + _declarationsOmatchIO = rule274 _lhsImatchIO + _declarationsOmonos = rule275 _lhsImonos + _declarationsOnamesInScope = rule276 _lhsInamesInScope + _declarationsOorderedTypeSynonyms = rule277 _lhsIorderedTypeSynonyms + _declarationsOparentTree = rule278 _parentTree + _declarationsOpatternMatchWarnings = rule279 _lhsIpatternMatchWarnings + _declarationsOsubstitution = rule280 _lhsIsubstitution + _declarationsOtypeschemeMap = rule281 _lhsItypeschemeMap + _declarationsOuniqueChunk = rule282 _lhsIuniqueChunk + __result_ = T_Body_vOut13 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOtoplevelTypes _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule236 #-} + rule236 = \ (_ :: ()) -> + [] + {-# INLINE rule237 #-} + rule237 = \ _aset _cinfo ((_lhsIimportEnvironment) :: ImportEnvironment) -> + (typeEnvironment _lhsIimportEnvironment .:::. _aset) _cinfo + {-# INLINE rule238 #-} + rule238 = \ _cset _csetBinds -> + _csetBinds .>>. _cset + {-# INLINE rule239 #-} + rule239 = \ ((_declarationsIbetaUnique) :: Int) ((_declarationsIbindingGroups) :: BindingGroups) ((_declarationsItypeSignatures) :: TypeEnvironment) ((_declarationsIuniqueChunk) :: Int) ((_lhsIcurrentChunk) :: Int) ((_lhsImonos) :: Monos) -> + let inputBDG = (True, _lhsIcurrentChunk, _declarationsIuniqueChunk, _lhsImonos, _declarationsItypeSignatures, Nothing, _declarationsIbetaUnique) + in performBindingGroup inputBDG _declarationsIbindingGroups + {-# INLINE rule240 #-} + rule240 = \ _implicitsFM ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + findInferredTypes _lhsItypeschemeMap _implicitsFM + {-# INLINE rule241 #-} + rule241 = \ ((_declarationsIcollectWarnings) :: Warnings) ((_declarationsIsimplePatNames) :: Names) _inferredTypes -> + missingTypeSignature True _declarationsIsimplePatNames _inferredTypes + ++ _declarationsIcollectWarnings + {-# INLINE rule242 #-} + rule242 = \ ((_declarationsIcollectErrors) :: TypeErrors) ((_declarationsIrestrictedNames) :: Names) _inferredTypes -> + restrictedNameErrors _inferredTypes _declarationsIrestrictedNames + ++ _declarationsIcollectErrors + {-# INLINE rule243 #-} + rule243 = \ ((_declarationsItypeSignatures) :: TypeEnvironment) _inferredTypes -> + _declarationsItypeSignatures `M.union` _inferredTypes + {-# INLINE rule244 #-} + rule244 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) _localTypes -> + _localTypes `M.union` _lhsIallTypeSchemes + {-# INLINE rule245 #-} + rule245 = \ ((_declarationsIbindingGroups) :: BindingGroups) ((_declarationsItypeSignatures) :: TypeEnvironment) _inferredTypes -> + makeLocalTypeEnv (_declarationsItypeSignatures `M.union` _inferredTypes) _declarationsIbindingGroups + {-# INLINE rule246 #-} + rule246 = \ (_ :: ()) -> + M.empty + {-# INLINE rule247 #-} + rule247 = \ _chunkNr -> + _chunkNr + {-# INLINE rule248 #-} + rule248 = \ (_ :: ()) -> + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint, HasTrustFactor 10.0, IsImported name ] + {-# INLINE rule249 #-} + rule249 = \ ((_declarationsIself) :: Declarations) ((_lhsImonos) :: Monos) -> + LocalInfo { self = UHA_Decls _declarationsIself + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule250 #-} + rule250 = \ _declInfo ((_declarationsIinfoTrees) :: InfoTrees) -> + root _declInfo _declarationsIinfoTrees + {-# INLINE rule251 #-} + rule251 = \ _parentTree -> + _parentTree + {-# INLINE rule252 #-} + rule252 = \ ((_declarationsIcollectInstances) :: [(Name, Instance)]) -> + _declarationsIcollectInstances + {-# INLINE rule253 #-} + rule253 = \ ((_declarationsIdeclVarNames) :: Names) -> + _declarationsIdeclVarNames + {-# INLINE rule254 #-} + rule254 = \ ((_declarationsIunboundNames) :: Names) -> + _declarationsIunboundNames + {-# INLINE rule255 #-} + rule255 = \ ((_declarationsIself) :: Declarations) ((_importdeclarationsIself) :: ImportDeclarations) ((_rangeIself) :: Range) -> + Body_Body _rangeIself _importdeclarationsIself _declarationsIself + {-# INLINE rule256 #-} + rule256 = \ _self -> + _self + {-# INLINE rule257 #-} + rule257 = \ _constraints -> + _constraints + {-# INLINE rule258 #-} + rule258 = \ ((_declarationsIcounter) :: Int) -> + _declarationsIcounter + {-# INLINE rule259 #-} + rule259 = \ ((_declarationsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _declarationsIdictionaryEnvironment + {-# INLINE rule260 #-} + rule260 = \ ((_declarationsImatchIO) :: IO ()) -> + _declarationsImatchIO + {-# INLINE rule261 #-} + rule261 = \ ((_declarationsIpatternMatchWarnings) :: [Warning]) -> + _declarationsIpatternMatchWarnings + {-# INLINE rule262 #-} + rule262 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule263 #-} + rule263 = \ _allTypeSchemes -> + _allTypeSchemes + {-# INLINE rule264 #-} + rule264 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule265 #-} + rule265 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule266 #-} + rule266 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule267 #-} + rule267 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule268 #-} + rule268 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule269 #-} + rule269 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule270 #-} + rule270 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule271 #-} + rule271 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule272 #-} + rule272 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule273 #-} + rule273 = \ _inheritedBDG -> + _inheritedBDG + {-# INLINE rule274 #-} + rule274 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule275 #-} + rule275 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule276 #-} + rule276 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule277 #-} + rule277 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule278 #-} + rule278 = \ _parentTree -> + _parentTree + {-# INLINE rule279 #-} + rule279 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule280 #-} + rule280 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule281 #-} + rule281 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule282 #-} + rule282 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + +-- Constructor ------------------------------------------------- +-- wrapper +data Inh_Constructor = Inh_Constructor { counter_Inh_Constructor :: (Int), namesInScope_Inh_Constructor :: (Names) } +data Syn_Constructor = Syn_Constructor { counter_Syn_Constructor :: (Int), self_Syn_Constructor :: (Constructor), unboundNames_Syn_Constructor :: (Names) } +{-# INLINABLE wrap_Constructor #-} +wrap_Constructor :: T_Constructor -> Inh_Constructor -> (Syn_Constructor ) +wrap_Constructor (T_Constructor act) (Inh_Constructor _lhsIcounter _lhsInamesInScope) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructor_vIn16 _lhsIcounter _lhsInamesInScope + (T_Constructor_vOut16 _lhsOcounter _lhsOself _lhsOunboundNames) <- return (inv_Constructor_s17 sem arg) + return (Syn_Constructor _lhsOcounter _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_Constructor #-} +sem_Constructor :: Constructor -> T_Constructor +sem_Constructor ( Constructor_Constructor range_ constructor_ types_ ) = sem_Constructor_Constructor ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_AnnotatedTypes types_ ) +sem_Constructor ( Constructor_Infix range_ leftType_ constructorOperator_ rightType_ ) = sem_Constructor_Infix ( sem_Range range_ ) ( sem_AnnotatedType leftType_ ) ( sem_Name constructorOperator_ ) ( sem_AnnotatedType rightType_ ) +sem_Constructor ( Constructor_Record range_ constructor_ fieldDeclarations_ ) = sem_Constructor_Record ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_FieldDeclarations fieldDeclarations_ ) + +-- semantic domain +newtype T_Constructor = T_Constructor { + attach_T_Constructor :: Identity (T_Constructor_s17 ) + } +newtype T_Constructor_s17 = C_Constructor_s17 { + inv_Constructor_s17 :: (T_Constructor_v16 ) + } +data T_Constructor_s18 = C_Constructor_s18 +type T_Constructor_v16 = (T_Constructor_vIn16 ) -> (T_Constructor_vOut16 ) +data T_Constructor_vIn16 = T_Constructor_vIn16 (Int) (Names) +data T_Constructor_vOut16 = T_Constructor_vOut16 (Int) (Constructor) (Names) +{-# NOINLINE sem_Constructor_Constructor #-} +sem_Constructor_Constructor :: T_Range -> T_Name -> T_AnnotatedTypes -> T_Constructor +sem_Constructor_Constructor arg_range_ arg_constructor_ arg_types_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIcounter _lhsInamesInScope) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _typesX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_AnnotatedTypes_vOut10 _typesIcounter _typesIself _typesIunboundNames) = inv_AnnotatedTypes_s11 _typesX11 (T_AnnotatedTypes_vIn10 _typesOcounter _typesOnamesInScope) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule283 _typesIunboundNames + _self = rule284 _constructorIself _rangeIself _typesIself + _lhsOself :: Constructor + _lhsOself = rule285 _self + _lhsOcounter :: Int + _lhsOcounter = rule286 _typesIcounter + _typesOcounter = rule287 _lhsIcounter + _typesOnamesInScope = rule288 _lhsInamesInScope + __result_ = T_Constructor_vOut16 _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule283 #-} + rule283 = \ ((_typesIunboundNames) :: Names) -> + _typesIunboundNames + {-# INLINE rule284 #-} + rule284 = \ ((_constructorIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: AnnotatedTypes) -> + Constructor_Constructor _rangeIself _constructorIself _typesIself + {-# INLINE rule285 #-} + rule285 = \ _self -> + _self + {-# INLINE rule286 #-} + rule286 = \ ((_typesIcounter) :: Int) -> + _typesIcounter + {-# INLINE rule287 #-} + rule287 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule288 #-} + rule288 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope +{-# NOINLINE sem_Constructor_Infix #-} +sem_Constructor_Infix :: T_Range -> T_AnnotatedType -> T_Name -> T_AnnotatedType -> T_Constructor +sem_Constructor_Infix arg_range_ arg_leftType_ arg_constructorOperator_ arg_rightType_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIcounter _lhsInamesInScope) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_leftType_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_rightType_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_AnnotatedType_vOut7 _leftTypeIcounter _leftTypeIself _leftTypeIunboundNames) = inv_AnnotatedType_s8 _leftTypeX8 (T_AnnotatedType_vIn7 _leftTypeOcounter _leftTypeOnamesInScope) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_AnnotatedType_vOut7 _rightTypeIcounter _rightTypeIself _rightTypeIunboundNames) = inv_AnnotatedType_s8 _rightTypeX8 (T_AnnotatedType_vIn7 _rightTypeOcounter _rightTypeOnamesInScope) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule289 _leftTypeIunboundNames _rightTypeIunboundNames + _self = rule290 _constructorOperatorIself _leftTypeIself _rangeIself _rightTypeIself + _lhsOself :: Constructor + _lhsOself = rule291 _self + _lhsOcounter :: Int + _lhsOcounter = rule292 _rightTypeIcounter + _leftTypeOcounter = rule293 _lhsIcounter + _leftTypeOnamesInScope = rule294 _lhsInamesInScope + _rightTypeOcounter = rule295 _leftTypeIcounter + _rightTypeOnamesInScope = rule296 _lhsInamesInScope + __result_ = T_Constructor_vOut16 _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule289 #-} + rule289 = \ ((_leftTypeIunboundNames) :: Names) ((_rightTypeIunboundNames) :: Names) -> + _leftTypeIunboundNames ++ _rightTypeIunboundNames + {-# INLINE rule290 #-} + rule290 = \ ((_constructorOperatorIself) :: Name) ((_leftTypeIself) :: AnnotatedType) ((_rangeIself) :: Range) ((_rightTypeIself) :: AnnotatedType) -> + Constructor_Infix _rangeIself _leftTypeIself _constructorOperatorIself _rightTypeIself + {-# INLINE rule291 #-} + rule291 = \ _self -> + _self + {-# INLINE rule292 #-} + rule292 = \ ((_rightTypeIcounter) :: Int) -> + _rightTypeIcounter + {-# INLINE rule293 #-} + rule293 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule294 #-} + rule294 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule295 #-} + rule295 = \ ((_leftTypeIcounter) :: Int) -> + _leftTypeIcounter + {-# INLINE rule296 #-} + rule296 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope +{-# NOINLINE sem_Constructor_Record #-} +sem_Constructor_Record :: T_Range -> T_Name -> T_FieldDeclarations -> T_Constructor +sem_Constructor_Record arg_range_ arg_constructor_ arg_fieldDeclarations_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIcounter _lhsInamesInScope) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _fieldDeclarationsX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_fieldDeclarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_FieldDeclarations_vOut49 _fieldDeclarationsIcounter _fieldDeclarationsIself _fieldDeclarationsIunboundNames) = inv_FieldDeclarations_s50 _fieldDeclarationsX50 (T_FieldDeclarations_vIn49 _fieldDeclarationsOcounter _fieldDeclarationsOnamesInScope) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule297 _fieldDeclarationsIunboundNames + _self = rule298 _constructorIself _fieldDeclarationsIself _rangeIself + _lhsOself :: Constructor + _lhsOself = rule299 _self + _lhsOcounter :: Int + _lhsOcounter = rule300 _fieldDeclarationsIcounter + _fieldDeclarationsOcounter = rule301 _lhsIcounter + _fieldDeclarationsOnamesInScope = rule302 _lhsInamesInScope + __result_ = T_Constructor_vOut16 _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule297 #-} + rule297 = \ ((_fieldDeclarationsIunboundNames) :: Names) -> + _fieldDeclarationsIunboundNames + {-# INLINE rule298 #-} + rule298 = \ ((_constructorIself) :: Name) ((_fieldDeclarationsIself) :: FieldDeclarations) ((_rangeIself) :: Range) -> + Constructor_Record _rangeIself _constructorIself _fieldDeclarationsIself + {-# INLINE rule299 #-} + rule299 = \ _self -> + _self + {-# INLINE rule300 #-} + rule300 = \ ((_fieldDeclarationsIcounter) :: Int) -> + _fieldDeclarationsIcounter + {-# INLINE rule301 #-} + rule301 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule302 #-} + rule302 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + +-- Constructors ------------------------------------------------ +-- wrapper +data Inh_Constructors = Inh_Constructors { counter_Inh_Constructors :: (Int), namesInScope_Inh_Constructors :: (Names) } +data Syn_Constructors = Syn_Constructors { counter_Syn_Constructors :: (Int), self_Syn_Constructors :: (Constructors), unboundNames_Syn_Constructors :: (Names) } +{-# INLINABLE wrap_Constructors #-} +wrap_Constructors :: T_Constructors -> Inh_Constructors -> (Syn_Constructors ) +wrap_Constructors (T_Constructors act) (Inh_Constructors _lhsIcounter _lhsInamesInScope) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructors_vIn19 _lhsIcounter _lhsInamesInScope + (T_Constructors_vOut19 _lhsOcounter _lhsOself _lhsOunboundNames) <- return (inv_Constructors_s20 sem arg) + return (Syn_Constructors _lhsOcounter _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_Constructors #-} +sem_Constructors :: Constructors -> T_Constructors +sem_Constructors list = Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list) + +-- semantic domain +newtype T_Constructors = T_Constructors { + attach_T_Constructors :: Identity (T_Constructors_s20 ) + } +newtype T_Constructors_s20 = C_Constructors_s20 { + inv_Constructors_s20 :: (T_Constructors_v19 ) + } +data T_Constructors_s21 = C_Constructors_s21 +type T_Constructors_v19 = (T_Constructors_vIn19 ) -> (T_Constructors_vOut19 ) +data T_Constructors_vIn19 = T_Constructors_vIn19 (Int) (Names) +data T_Constructors_vOut19 = T_Constructors_vOut19 (Int) (Constructors) (Names) +{-# NOINLINE sem_Constructors_Cons #-} +sem_Constructors_Cons :: T_Constructor -> T_Constructors -> T_Constructors +sem_Constructors_Cons arg_hd_ arg_tl_ = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 _lhsIcounter _lhsInamesInScope) -> ( let + _hdX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_hd_)) + _tlX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_tl_)) + (T_Constructor_vOut16 _hdIcounter _hdIself _hdIunboundNames) = inv_Constructor_s17 _hdX17 (T_Constructor_vIn16 _hdOcounter _hdOnamesInScope) + (T_Constructors_vOut19 _tlIcounter _tlIself _tlIunboundNames) = inv_Constructors_s20 _tlX20 (T_Constructors_vIn19 _tlOcounter _tlOnamesInScope) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule303 _hdIunboundNames _tlIunboundNames + _self = rule304 _hdIself _tlIself + _lhsOself :: Constructors + _lhsOself = rule305 _self + _lhsOcounter :: Int + _lhsOcounter = rule306 _tlIcounter + _hdOcounter = rule307 _lhsIcounter + _hdOnamesInScope = rule308 _lhsInamesInScope + _tlOcounter = rule309 _hdIcounter + _tlOnamesInScope = rule310 _lhsInamesInScope + __result_ = T_Constructors_vOut19 _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule303 #-} + rule303 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule304 #-} + rule304 = \ ((_hdIself) :: Constructor) ((_tlIself) :: Constructors) -> + (:) _hdIself _tlIself + {-# INLINE rule305 #-} + rule305 = \ _self -> + _self + {-# INLINE rule306 #-} + rule306 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule307 #-} + rule307 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule308 #-} + rule308 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule309 #-} + rule309 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule310 #-} + rule310 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope +{-# NOINLINE sem_Constructors_Nil #-} +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 _lhsIcounter _lhsInamesInScope) -> ( let + _lhsOunboundNames :: Names + _lhsOunboundNames = rule311 () + _self = rule312 () + _lhsOself :: Constructors + _lhsOself = rule313 _self + _lhsOcounter :: Int + _lhsOcounter = rule314 _lhsIcounter + __result_ = T_Constructors_vOut19 _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule311 #-} + rule311 = \ (_ :: ()) -> + [] + {-# INLINE rule312 #-} + rule312 = \ (_ :: ()) -> + [] + {-# INLINE rule313 #-} + rule313 = \ _self -> + _self + {-# INLINE rule314 #-} + rule314 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + +-- ContextItem ------------------------------------------------- +-- wrapper +data Inh_ContextItem = Inh_ContextItem { } +data Syn_ContextItem = Syn_ContextItem { self_Syn_ContextItem :: (ContextItem) } +{-# INLINABLE wrap_ContextItem #-} +wrap_ContextItem :: T_ContextItem -> Inh_ContextItem -> (Syn_ContextItem ) +wrap_ContextItem (T_ContextItem act) (Inh_ContextItem ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItem_vIn22 + (T_ContextItem_vOut22 _lhsOself) <- return (inv_ContextItem_s23 sem arg) + return (Syn_ContextItem _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItem #-} +sem_ContextItem :: ContextItem -> T_ContextItem +sem_ContextItem ( ContextItem_ContextItem range_ name_ types_ ) = sem_ContextItem_ContextItem ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Types types_ ) + +-- semantic domain +newtype T_ContextItem = T_ContextItem { + attach_T_ContextItem :: Identity (T_ContextItem_s23 ) + } +newtype T_ContextItem_s23 = C_ContextItem_s23 { + inv_ContextItem_s23 :: (T_ContextItem_v22 ) + } +data T_ContextItem_s24 = C_ContextItem_s24 +type T_ContextItem_v22 = (T_ContextItem_vIn22 ) -> (T_ContextItem_vOut22 ) +data T_ContextItem_vIn22 = T_ContextItem_vIn22 +data T_ContextItem_vOut22 = T_ContextItem_vOut22 (ContextItem) +{-# NOINLINE sem_ContextItem_ContextItem #-} +sem_ContextItem_ContextItem :: T_Range -> T_Name -> T_Types -> T_ContextItem +sem_ContextItem_ContextItem arg_range_ arg_name_ arg_types_ = T_ContextItem (return st23) where + {-# NOINLINE st23 #-} + st23 = let + v22 :: T_ContextItem_v22 + v22 = \ (T_ContextItem_vIn22 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _tyconEnv = rule315 () + _self = rule316 _nameIself _rangeIself _typesIself + _lhsOself :: ContextItem + _lhsOself = rule317 _self + __result_ = T_ContextItem_vOut22 _lhsOself + in __result_ ) + in C_ContextItem_s23 v22 + {-# INLINE rule315 #-} + rule315 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "ContextItem.ContextItem" + {-# INLINE rule316 #-} + rule316 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + ContextItem_ContextItem _rangeIself _nameIself _typesIself + {-# INLINE rule317 #-} + rule317 = \ _self -> + _self + +-- ContextItems ------------------------------------------------ +-- wrapper +data Inh_ContextItems = Inh_ContextItems { } +data Syn_ContextItems = Syn_ContextItems { self_Syn_ContextItems :: (ContextItems) } +{-# INLINABLE wrap_ContextItems #-} +wrap_ContextItems :: T_ContextItems -> Inh_ContextItems -> (Syn_ContextItems ) +wrap_ContextItems (T_ContextItems act) (Inh_ContextItems ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItems_vIn25 + (T_ContextItems_vOut25 _lhsOself) <- return (inv_ContextItems_s26 sem arg) + return (Syn_ContextItems _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItems #-} +sem_ContextItems :: ContextItems -> T_ContextItems +sem_ContextItems list = Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list) + +-- semantic domain +newtype T_ContextItems = T_ContextItems { + attach_T_ContextItems :: Identity (T_ContextItems_s26 ) + } +newtype T_ContextItems_s26 = C_ContextItems_s26 { + inv_ContextItems_s26 :: (T_ContextItems_v25 ) + } +data T_ContextItems_s27 = C_ContextItems_s27 +type T_ContextItems_v25 = (T_ContextItems_vIn25 ) -> (T_ContextItems_vOut25 ) +data T_ContextItems_vIn25 = T_ContextItems_vIn25 +data T_ContextItems_vOut25 = T_ContextItems_vOut25 (ContextItems) +{-# NOINLINE sem_ContextItems_Cons #-} +sem_ContextItems_Cons :: T_ContextItem -> T_ContextItems -> T_ContextItems +sem_ContextItems_Cons arg_hd_ arg_tl_ = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _hdX23 = Control.Monad.Identity.runIdentity (attach_T_ContextItem (arg_hd_)) + _tlX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_tl_)) + (T_ContextItem_vOut22 _hdIself) = inv_ContextItem_s23 _hdX23 (T_ContextItem_vIn22 ) + (T_ContextItems_vOut25 _tlIself) = inv_ContextItems_s26 _tlX26 (T_ContextItems_vIn25 ) + _self = rule318 _hdIself _tlIself + _lhsOself :: ContextItems + _lhsOself = rule319 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule318 #-} + rule318 = \ ((_hdIself) :: ContextItem) ((_tlIself) :: ContextItems) -> + (:) _hdIself _tlIself + {-# INLINE rule319 #-} + rule319 = \ _self -> + _self +{-# NOINLINE sem_ContextItems_Nil #-} +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _self = rule320 () + _lhsOself :: ContextItems + _lhsOself = rule321 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule320 #-} + rule320 = \ (_ :: ()) -> + [] + {-# INLINE rule321 #-} + rule321 = \ _self -> + _self + +-- Declaration ------------------------------------------------- +-- wrapper +data Inh_Declaration = Inh_Declaration { allPatterns_Inh_Declaration :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_Declaration :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_Declaration :: (Predicates), betaUnique_Inh_Declaration :: (Int), bindingGroups_Inh_Declaration :: (BindingGroups), classEnvironment_Inh_Declaration :: (ClassEnvironment), collectErrors_Inh_Declaration :: (TypeErrors), collectWarnings_Inh_Declaration :: (Warnings), counter_Inh_Declaration :: (Int), currentChunk_Inh_Declaration :: (Int), dictionaryEnvironment_Inh_Declaration :: (DictionaryEnvironment), importEnvironment_Inh_Declaration :: (ImportEnvironment), inheritedBDG_Inh_Declaration :: (InheritedBDG), matchIO_Inh_Declaration :: (IO ()), monos_Inh_Declaration :: (Monos), namesInScope_Inh_Declaration :: (Names), orderedTypeSynonyms_Inh_Declaration :: (OrderedTypeSynonyms), parentTree_Inh_Declaration :: (InfoTree), patternMatchWarnings_Inh_Declaration :: ([Warning]), substitution_Inh_Declaration :: (FixpointSubstitution), typeSignatures_Inh_Declaration :: (TypeEnvironment), typeschemeMap_Inh_Declaration :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_Declaration :: (Int) } +data Syn_Declaration = Syn_Declaration { betaUnique_Syn_Declaration :: (Int), bindingGroups_Syn_Declaration :: (BindingGroups), collectErrors_Syn_Declaration :: (TypeErrors), collectInstances_Syn_Declaration :: ([(Name, Instance)]), collectWarnings_Syn_Declaration :: (Warnings), counter_Syn_Declaration :: (Int), declVarNames_Syn_Declaration :: (Names), dictionaryEnvironment_Syn_Declaration :: (DictionaryEnvironment), infoTrees_Syn_Declaration :: (InfoTrees), matchIO_Syn_Declaration :: (IO ()), patternMatchWarnings_Syn_Declaration :: ([Warning]), restrictedNames_Syn_Declaration :: (Names), self_Syn_Declaration :: (Declaration), simplePatNames_Syn_Declaration :: (Names), typeSignatures_Syn_Declaration :: (TypeEnvironment), unboundNames_Syn_Declaration :: (Names), uniqueChunk_Syn_Declaration :: (Int) } +{-# INLINABLE wrap_Declaration #-} +wrap_Declaration :: T_Declaration -> Inh_Declaration -> (Syn_Declaration ) +wrap_Declaration (T_Declaration act) (Inh_Declaration _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk + (T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk) <- return (inv_Declaration_s29 sem arg) + return (Syn_Declaration _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk) + ) + +-- cata +{-# NOINLINE sem_Declaration #-} +sem_Declaration :: Declaration -> T_Declaration +sem_Declaration ( Declaration_Hole range_ id_ ) = sem_Declaration_Hole ( sem_Range range_ ) id_ +sem_Declaration ( Declaration_Type range_ simpletype_ type_ ) = sem_Declaration_Type ( sem_Range range_ ) ( sem_SimpleType simpletype_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Data range_ context_ simpletype_ constructors_ derivings_ ) = sem_Declaration_Data ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructors constructors_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Newtype range_ context_ simpletype_ constructor_ derivings_ ) = sem_Declaration_Newtype ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructor constructor_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Class range_ context_ simpletype_ where_ ) = sem_Declaration_Class ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Instance range_ context_ name_ types_ where_ ) = sem_Declaration_Instance ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Name name_ ) ( sem_Types types_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Default range_ types_ ) = sem_Declaration_Default ( sem_Range range_ ) ( sem_Types types_ ) +sem_Declaration ( Declaration_FunctionBindings range_ bindings_ ) = sem_Declaration_FunctionBindings ( sem_Range range_ ) ( sem_FunctionBindings bindings_ ) +sem_Declaration ( Declaration_PatternBinding range_ pattern_ righthandside_ ) = sem_Declaration_PatternBinding ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Declaration ( Declaration_TypeSignature range_ names_ type_ ) = sem_Declaration_TypeSignature ( sem_Range range_ ) ( sem_Names names_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Fixity range_ fixity_ priority_ operators_ ) = sem_Declaration_Fixity ( sem_Range range_ ) ( sem_Fixity fixity_ ) ( sem_MaybeInt priority_ ) ( sem_Names operators_ ) +sem_Declaration ( Declaration_Empty range_ ) = sem_Declaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Declaration = T_Declaration { + attach_T_Declaration :: Identity (T_Declaration_s29 ) + } +newtype T_Declaration_s29 = C_Declaration_s29 { + inv_Declaration_s29 :: (T_Declaration_v28 ) + } +data T_Declaration_s30 = C_Declaration_s30 +type T_Declaration_v28 = (T_Declaration_vIn28 ) -> (T_Declaration_vOut28 ) +data T_Declaration_vIn28 = T_Declaration_vIn28 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Int) (BindingGroups) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (InheritedBDG) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (TypeEnvironment) (M.Map Int (Scheme Predicates)) (Int) +data T_Declaration_vOut28 = T_Declaration_vOut28 (Int) (BindingGroups) (TypeErrors) ([(Name, Instance)]) (Warnings) (Int) (Names) (DictionaryEnvironment) (InfoTrees) (IO ()) ([Warning]) (Names) (Declaration) (Names) (TypeEnvironment) (Names) (Int) +{-# NOINLINE sem_Declaration_Hole #-} +sem_Declaration_Hole :: T_Range -> (Integer) -> T_Declaration +sem_Declaration_Hole arg_range_ arg_id_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule322 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule323 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule324 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule325 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule326 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule327 () + _self = rule328 _rangeIself arg_id_ + _lhsOself :: Declaration + _lhsOself = rule329 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule330 _lhsIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule331 _lhsIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule332 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule333 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule334 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule335 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule336 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule337 _lhsIpatternMatchWarnings + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule338 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule339 _lhsIuniqueChunk + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule322 #-} + rule322 = \ (_ :: ()) -> + [] + {-# INLINE rule323 #-} + rule323 = \ (_ :: ()) -> + [] + {-# INLINE rule324 #-} + rule324 = \ (_ :: ()) -> + [] + {-# INLINE rule325 #-} + rule325 = \ (_ :: ()) -> + [] + {-# INLINE rule326 #-} + rule326 = \ (_ :: ()) -> + [] + {-# INLINE rule327 #-} + rule327 = \ (_ :: ()) -> + [] + {-# INLINE rule328 #-} + rule328 = \ ((_rangeIself) :: Range) id_ -> + Declaration_Hole _rangeIself id_ + {-# INLINE rule329 #-} + rule329 = \ _self -> + _self + {-# INLINE rule330 #-} + rule330 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule331 #-} + rule331 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule332 #-} + rule332 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule333 #-} + rule333 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule334 #-} + rule334 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule335 #-} + rule335 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule336 #-} + rule336 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule337 #-} + rule337 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule338 #-} + rule338 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule339 #-} + rule339 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Declaration_Type #-} +sem_Declaration_Type :: T_Range -> T_SimpleType -> T_Type -> T_Declaration +sem_Declaration_Type arg_range_ arg_simpletype_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule340 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule341 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule342 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule343 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule344 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule345 () + _self = rule346 _rangeIself _simpletypeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule347 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule348 _lhsIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule349 _lhsIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule350 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule351 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule352 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule353 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule354 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule355 _lhsIpatternMatchWarnings + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule356 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule357 _lhsIuniqueChunk + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule340 #-} + rule340 = \ (_ :: ()) -> + [] + {-# INLINE rule341 #-} + rule341 = \ (_ :: ()) -> + [] + {-# INLINE rule342 #-} + rule342 = \ (_ :: ()) -> + [] + {-# INLINE rule343 #-} + rule343 = \ (_ :: ()) -> + [] + {-# INLINE rule344 #-} + rule344 = \ (_ :: ()) -> + [] + {-# INLINE rule345 #-} + rule345 = \ (_ :: ()) -> + [] + {-# INLINE rule346 #-} + rule346 = \ ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_typeIself) :: Type) -> + Declaration_Type _rangeIself _simpletypeIself _typeIself + {-# INLINE rule347 #-} + rule347 = \ _self -> + _self + {-# INLINE rule348 #-} + rule348 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule349 #-} + rule349 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule350 #-} + rule350 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule351 #-} + rule351 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule352 #-} + rule352 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule353 #-} + rule353 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule354 #-} + rule354 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule355 #-} + rule355 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule356 #-} + rule356 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule357 #-} + rule357 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Declaration_Data #-} +sem_Declaration_Data :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructors -> T_Names -> T_Declaration +sem_Declaration_Data arg_range_ arg_context_ arg_simpletype_ arg_constructors_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorsX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_constructors_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructors_vOut19 _constructorsIcounter _constructorsIself _constructorsIunboundNames) = inv_Constructors_s20 _constructorsX20 (T_Constructors_vIn19 _constructorsOcounter _constructorsOnamesInScope) + (T_Names_vOut115 _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule358 _derivingsIself _simpletypeIname _simpletypeItypevariables + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule359 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule360 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule361 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule362 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule363 _constructorsIunboundNames + _self = rule364 _constructorsIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule365 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule366 _lhsIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule367 _lhsIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule368 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule369 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule370 _constructorsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule371 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule372 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule373 _lhsIpatternMatchWarnings + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule374 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule375 _lhsIuniqueChunk + _constructorsOcounter = rule376 _lhsIcounter + _constructorsOnamesInScope = rule377 _lhsInamesInScope + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule358 #-} + rule358 = \ ((_derivingsIself) :: Names) ((_simpletypeIname) :: Name) ((_simpletypeItypevariables) :: Names) -> + [ (cl, makeInstance (show cl) (length _simpletypeItypevariables) (show _simpletypeIname) ) + | cl <- _derivingsIself + ] + {-# INLINE rule359 #-} + rule359 = \ (_ :: ()) -> + [] + {-# INLINE rule360 #-} + rule360 = \ (_ :: ()) -> + [] + {-# INLINE rule361 #-} + rule361 = \ (_ :: ()) -> + [] + {-# INLINE rule362 #-} + rule362 = \ (_ :: ()) -> + [] + {-# INLINE rule363 #-} + rule363 = \ ((_constructorsIunboundNames) :: Names) -> + _constructorsIunboundNames + {-# INLINE rule364 #-} + rule364 = \ ((_constructorsIself) :: Constructors) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Data _rangeIself _contextIself _simpletypeIself _constructorsIself _derivingsIself + {-# INLINE rule365 #-} + rule365 = \ _self -> + _self + {-# INLINE rule366 #-} + rule366 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule367 #-} + rule367 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule368 #-} + rule368 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule369 #-} + rule369 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule370 #-} + rule370 = \ ((_constructorsIcounter) :: Int) -> + _constructorsIcounter + {-# INLINE rule371 #-} + rule371 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule372 #-} + rule372 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule373 #-} + rule373 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule374 #-} + rule374 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule375 #-} + rule375 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule376 #-} + rule376 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule377 #-} + rule377 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope +{-# NOINLINE sem_Declaration_Newtype #-} +sem_Declaration_Newtype :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructor -> T_Names -> T_Declaration +sem_Declaration_Newtype arg_range_ arg_context_ arg_simpletype_ arg_constructor_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_constructor_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructor_vOut16 _constructorIcounter _constructorIself _constructorIunboundNames) = inv_Constructor_s17 _constructorX17 (T_Constructor_vIn16 _constructorOcounter _constructorOnamesInScope) + (T_Names_vOut115 _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _infoTrees = rule378 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule379 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule380 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule381 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule382 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule383 _constructorIunboundNames + _self = rule384 _constructorIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule385 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule386 _lhsIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule387 _lhsIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule388 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule389 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule390 _constructorIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule391 _lhsIdictionaryEnvironment + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule392 _infoTrees + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule393 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule394 _lhsIpatternMatchWarnings + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule395 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule396 _lhsIuniqueChunk + _constructorOcounter = rule397 _lhsIcounter + _constructorOnamesInScope = rule398 _lhsInamesInScope + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule378 #-} + rule378 = \ (_ :: ()) -> + globalInfoError + {-# INLINE rule379 #-} + rule379 = \ (_ :: ()) -> + [] + {-# INLINE rule380 #-} + rule380 = \ (_ :: ()) -> + [] + {-# INLINE rule381 #-} + rule381 = \ (_ :: ()) -> + [] + {-# INLINE rule382 #-} + rule382 = \ (_ :: ()) -> + [] + {-# INLINE rule383 #-} + rule383 = \ ((_constructorIunboundNames) :: Names) -> + _constructorIunboundNames + {-# INLINE rule384 #-} + rule384 = \ ((_constructorIself) :: Constructor) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Newtype _rangeIself _contextIself _simpletypeIself _constructorIself _derivingsIself + {-# INLINE rule385 #-} + rule385 = \ _self -> + _self + {-# INLINE rule386 #-} + rule386 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule387 #-} + rule387 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule388 #-} + rule388 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule389 #-} + rule389 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule390 #-} + rule390 = \ ((_constructorIcounter) :: Int) -> + _constructorIcounter + {-# INLINE rule391 #-} + rule391 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule392 #-} + rule392 = \ _infoTrees -> + _infoTrees + {-# INLINE rule393 #-} + rule393 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule394 #-} + rule394 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule395 #-} + rule395 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule396 #-} + rule396 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule397 #-} + rule397 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule398 #-} + rule398 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope +{-# NOINLINE sem_Declaration_Class #-} +sem_Declaration_Class :: T_Range -> T_ContextItems -> T_SimpleType -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Class arg_range_ arg_context_ arg_simpletype_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_MaybeDeclarations_vOut88 _whereIassumptions _whereIbetaUnique _whereIcollectErrors _whereIcollectInstances _whereIcollectWarnings _whereIconstraints _whereIcounter _whereIdictionaryEnvironment _whereIinfoTrees _whereIlocalTypes _whereImatchIO _whereInamesInScope _whereIpatternMatchWarnings _whereIself _whereIunboundNames _whereIuniqueChunk) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOallPatterns _whereOallTypeSchemes _whereOassumptions _whereOavailablePredicates _whereObetaUnique _whereOclassEnvironment _whereOcollectErrors _whereOcollectWarnings _whereOconstraints _whereOcounter _whereOcurrentChunk _whereOdictionaryEnvironment _whereOimportEnvironment _whereOmatchIO _whereOmonos _whereOnamesInScope _whereOorderedTypeSynonyms _whereOparentTree _whereOpatternMatchWarnings _whereOsubstitution _whereOtypeschemeMap _whereOunboundNames _whereOuniqueChunk) + (_assumptions,_constraints,_unboundNames) = rule399 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule400 _whereIcollectInstances + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule401 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule402 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule403 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule404 _unboundNames + _self = rule405 _contextIself _rangeIself _simpletypeIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule406 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule407 _whereIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule408 _lhsIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule409 _whereIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule410 _whereIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule411 _whereIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule412 _whereIdictionaryEnvironment + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule413 _whereIinfoTrees + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule414 _whereImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule415 _whereIpatternMatchWarnings + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule416 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule417 _whereIuniqueChunk + _whereOallPatterns = rule418 _lhsIallPatterns + _whereOallTypeSchemes = rule419 _lhsIallTypeSchemes + _whereOassumptions = rule420 _assumptions + _whereOavailablePredicates = rule421 _lhsIavailablePredicates + _whereObetaUnique = rule422 _lhsIbetaUnique + _whereOclassEnvironment = rule423 _lhsIclassEnvironment + _whereOcollectErrors = rule424 _lhsIcollectErrors + _whereOcollectWarnings = rule425 _lhsIcollectWarnings + _whereOconstraints = rule426 _constraints + _whereOcounter = rule427 _lhsIcounter + _whereOcurrentChunk = rule428 _lhsIcurrentChunk + _whereOdictionaryEnvironment = rule429 _lhsIdictionaryEnvironment + _whereOimportEnvironment = rule430 _lhsIimportEnvironment + _whereOmatchIO = rule431 _lhsImatchIO + _whereOmonos = rule432 _lhsImonos + _whereOnamesInScope = rule433 _lhsInamesInScope + _whereOorderedTypeSynonyms = rule434 _lhsIorderedTypeSynonyms + _whereOparentTree = rule435 _lhsIparentTree + _whereOpatternMatchWarnings = rule436 _lhsIpatternMatchWarnings + _whereOsubstitution = rule437 _lhsIsubstitution + _whereOtypeschemeMap = rule438 _lhsItypeschemeMap + _whereOunboundNames = rule439 _unboundNames + _whereOuniqueChunk = rule440 _lhsIuniqueChunk + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule399 #-} + rule399 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "Declaration.Class" + {-# INLINE rule400 #-} + rule400 = \ ((_whereIcollectInstances) :: [(Name, Instance)]) -> + _whereIcollectInstances + {-# INLINE rule401 #-} + rule401 = \ (_ :: ()) -> + [] + {-# INLINE rule402 #-} + rule402 = \ (_ :: ()) -> + [] + {-# INLINE rule403 #-} + rule403 = \ (_ :: ()) -> + [] + {-# INLINE rule404 #-} + rule404 = \ _unboundNames -> + _unboundNames + {-# INLINE rule405 #-} + rule405 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Class _rangeIself _contextIself _simpletypeIself _whereIself + {-# INLINE rule406 #-} + rule406 = \ _self -> + _self + {-# INLINE rule407 #-} + rule407 = \ ((_whereIbetaUnique) :: Int) -> + _whereIbetaUnique + {-# INLINE rule408 #-} + rule408 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule409 #-} + rule409 = \ ((_whereIcollectErrors) :: TypeErrors) -> + _whereIcollectErrors + {-# INLINE rule410 #-} + rule410 = \ ((_whereIcollectWarnings) :: Warnings) -> + _whereIcollectWarnings + {-# INLINE rule411 #-} + rule411 = \ ((_whereIcounter) :: Int) -> + _whereIcounter + {-# INLINE rule412 #-} + rule412 = \ ((_whereIdictionaryEnvironment) :: DictionaryEnvironment) -> + _whereIdictionaryEnvironment + {-# INLINE rule413 #-} + rule413 = \ ((_whereIinfoTrees) :: InfoTrees) -> + _whereIinfoTrees + {-# INLINE rule414 #-} + rule414 = \ ((_whereImatchIO) :: IO ()) -> + _whereImatchIO + {-# INLINE rule415 #-} + rule415 = \ ((_whereIpatternMatchWarnings) :: [Warning]) -> + _whereIpatternMatchWarnings + {-# INLINE rule416 #-} + rule416 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule417 #-} + rule417 = \ ((_whereIuniqueChunk) :: Int) -> + _whereIuniqueChunk + {-# INLINE rule418 #-} + rule418 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule419 #-} + rule419 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule420 #-} + rule420 = \ _assumptions -> + _assumptions + {-# INLINE rule421 #-} + rule421 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule422 #-} + rule422 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule423 #-} + rule423 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule424 #-} + rule424 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule425 #-} + rule425 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule426 #-} + rule426 = \ _constraints -> + _constraints + {-# INLINE rule427 #-} + rule427 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule428 #-} + rule428 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule429 #-} + rule429 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule430 #-} + rule430 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule431 #-} + rule431 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule432 #-} + rule432 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule433 #-} + rule433 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule434 #-} + rule434 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule435 #-} + rule435 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule436 #-} + rule436 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule437 #-} + rule437 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule438 #-} + rule438 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule439 #-} + rule439 = \ _unboundNames -> + _unboundNames + {-# INLINE rule440 #-} + rule440 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Declaration_Instance #-} +sem_Declaration_Instance :: T_Range -> T_ContextItems -> T_Name -> T_Types -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Instance arg_range_ arg_context_ arg_name_ arg_types_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + (T_MaybeDeclarations_vOut88 _whereIassumptions _whereIbetaUnique _whereIcollectErrors _whereIcollectInstances _whereIcollectWarnings _whereIconstraints _whereIcounter _whereIdictionaryEnvironment _whereIinfoTrees _whereIlocalTypes _whereImatchIO _whereInamesInScope _whereIpatternMatchWarnings _whereIself _whereIunboundNames _whereIuniqueChunk) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOallPatterns _whereOallTypeSchemes _whereOassumptions _whereOavailablePredicates _whereObetaUnique _whereOclassEnvironment _whereOcollectErrors _whereOcollectWarnings _whereOconstraints _whereOcounter _whereOcurrentChunk _whereOdictionaryEnvironment _whereOimportEnvironment _whereOmatchIO _whereOmonos _whereOnamesInScope _whereOorderedTypeSynonyms _whereOparentTree _whereOpatternMatchWarnings _whereOsubstitution _whereOtypeschemeMap _whereOunboundNames _whereOuniqueChunk) + (_assumptions,_constraints,_unboundNames) = rule441 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule442 _whereIcollectInstances + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule443 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule444 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule445 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule446 _unboundNames + _self = rule447 _contextIself _nameIself _rangeIself _typesIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule448 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule449 _whereIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule450 _lhsIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule451 _whereIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule452 _whereIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule453 _whereIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule454 _whereIdictionaryEnvironment + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule455 _whereIinfoTrees + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule456 _whereImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule457 _whereIpatternMatchWarnings + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule458 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule459 _whereIuniqueChunk + _whereOallPatterns = rule460 _lhsIallPatterns + _whereOallTypeSchemes = rule461 _lhsIallTypeSchemes + _whereOassumptions = rule462 _assumptions + _whereOavailablePredicates = rule463 _lhsIavailablePredicates + _whereObetaUnique = rule464 _lhsIbetaUnique + _whereOclassEnvironment = rule465 _lhsIclassEnvironment + _whereOcollectErrors = rule466 _lhsIcollectErrors + _whereOcollectWarnings = rule467 _lhsIcollectWarnings + _whereOconstraints = rule468 _constraints + _whereOcounter = rule469 _lhsIcounter + _whereOcurrentChunk = rule470 _lhsIcurrentChunk + _whereOdictionaryEnvironment = rule471 _lhsIdictionaryEnvironment + _whereOimportEnvironment = rule472 _lhsIimportEnvironment + _whereOmatchIO = rule473 _lhsImatchIO + _whereOmonos = rule474 _lhsImonos + _whereOnamesInScope = rule475 _lhsInamesInScope + _whereOorderedTypeSynonyms = rule476 _lhsIorderedTypeSynonyms + _whereOparentTree = rule477 _lhsIparentTree + _whereOpatternMatchWarnings = rule478 _lhsIpatternMatchWarnings + _whereOsubstitution = rule479 _lhsIsubstitution + _whereOtypeschemeMap = rule480 _lhsItypeschemeMap + _whereOunboundNames = rule481 _unboundNames + _whereOuniqueChunk = rule482 _lhsIuniqueChunk + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule441 #-} + rule441 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "Declaration.Instance" + {-# INLINE rule442 #-} + rule442 = \ ((_whereIcollectInstances) :: [(Name, Instance)]) -> + _whereIcollectInstances + {-# INLINE rule443 #-} + rule443 = \ (_ :: ()) -> + [] + {-# INLINE rule444 #-} + rule444 = \ (_ :: ()) -> + [] + {-# INLINE rule445 #-} + rule445 = \ (_ :: ()) -> + [] + {-# INLINE rule446 #-} + rule446 = \ _unboundNames -> + _unboundNames + {-# INLINE rule447 #-} + rule447 = \ ((_contextIself) :: ContextItems) ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Instance _rangeIself _contextIself _nameIself _typesIself _whereIself + {-# INLINE rule448 #-} + rule448 = \ _self -> + _self + {-# INLINE rule449 #-} + rule449 = \ ((_whereIbetaUnique) :: Int) -> + _whereIbetaUnique + {-# INLINE rule450 #-} + rule450 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule451 #-} + rule451 = \ ((_whereIcollectErrors) :: TypeErrors) -> + _whereIcollectErrors + {-# INLINE rule452 #-} + rule452 = \ ((_whereIcollectWarnings) :: Warnings) -> + _whereIcollectWarnings + {-# INLINE rule453 #-} + rule453 = \ ((_whereIcounter) :: Int) -> + _whereIcounter + {-# INLINE rule454 #-} + rule454 = \ ((_whereIdictionaryEnvironment) :: DictionaryEnvironment) -> + _whereIdictionaryEnvironment + {-# INLINE rule455 #-} + rule455 = \ ((_whereIinfoTrees) :: InfoTrees) -> + _whereIinfoTrees + {-# INLINE rule456 #-} + rule456 = \ ((_whereImatchIO) :: IO ()) -> + _whereImatchIO + {-# INLINE rule457 #-} + rule457 = \ ((_whereIpatternMatchWarnings) :: [Warning]) -> + _whereIpatternMatchWarnings + {-# INLINE rule458 #-} + rule458 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule459 #-} + rule459 = \ ((_whereIuniqueChunk) :: Int) -> + _whereIuniqueChunk + {-# INLINE rule460 #-} + rule460 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule461 #-} + rule461 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule462 #-} + rule462 = \ _assumptions -> + _assumptions + {-# INLINE rule463 #-} + rule463 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule464 #-} + rule464 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule465 #-} + rule465 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule466 #-} + rule466 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule467 #-} + rule467 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule468 #-} + rule468 = \ _constraints -> + _constraints + {-# INLINE rule469 #-} + rule469 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule470 #-} + rule470 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule471 #-} + rule471 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule472 #-} + rule472 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule473 #-} + rule473 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule474 #-} + rule474 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule475 #-} + rule475 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule476 #-} + rule476 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule477 #-} + rule477 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule478 #-} + rule478 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule479 #-} + rule479 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule480 #-} + rule480 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule481 #-} + rule481 = \ _unboundNames -> + _unboundNames + {-# INLINE rule482 #-} + rule482 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Declaration_Default #-} +sem_Declaration_Default :: T_Range -> T_Types -> T_Declaration +sem_Declaration_Default arg_range_ arg_types_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _infoTrees = rule483 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule484 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule485 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule486 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule487 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule488 () + _self = rule489 _rangeIself _typesIself + _lhsOself :: Declaration + _lhsOself = rule490 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule491 _lhsIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule492 _lhsIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule493 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule494 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule495 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule496 _lhsIdictionaryEnvironment + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule497 _infoTrees + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule498 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule499 _lhsIpatternMatchWarnings + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule500 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule501 _lhsIuniqueChunk + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule483 #-} + rule483 = \ (_ :: ()) -> + globalInfoError + {-# INLINE rule484 #-} + rule484 = \ (_ :: ()) -> + [] + {-# INLINE rule485 #-} + rule485 = \ (_ :: ()) -> + [] + {-# INLINE rule486 #-} + rule486 = \ (_ :: ()) -> + [] + {-# INLINE rule487 #-} + rule487 = \ (_ :: ()) -> + [] + {-# INLINE rule488 #-} + rule488 = \ (_ :: ()) -> + [] + {-# INLINE rule489 #-} + rule489 = \ ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + Declaration_Default _rangeIself _typesIself + {-# INLINE rule490 #-} + rule490 = \ _self -> + _self + {-# INLINE rule491 #-} + rule491 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule492 #-} + rule492 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule493 #-} + rule493 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule494 #-} + rule494 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule495 #-} + rule495 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule496 #-} + rule496 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule497 #-} + rule497 = \ _infoTrees -> + _infoTrees + {-# INLINE rule498 #-} + rule498 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule499 #-} + rule499 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule500 #-} + rule500 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule501 #-} + rule501 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Declaration_FunctionBindings #-} +sem_Declaration_FunctionBindings :: T_Range -> T_FunctionBindings -> T_Declaration +sem_Declaration_FunctionBindings arg_range_ arg_bindings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _bindingsX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_bindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBindings_vOut58 _bindingsIargcount _bindingsIassumptions _bindingsIbetaUnique _bindingsIcollectErrors _bindingsIcollectInstances _bindingsIcollectWarnings _bindingsIconstraintslist _bindingsIcounter _bindingsIdictionaryEnvironment _bindingsIelementss _bindingsIinfoTrees _bindingsImatchIO _bindingsIname _bindingsInumberOfPatterns _bindingsIpatternMatchWarnings _bindingsIself _bindingsIunboundNames _bindingsIuniqueChunk _bindingsIunrwars) = inv_FunctionBindings_s59 _bindingsX59 (T_FunctionBindings_vIn58 _bindingsOallPatterns _bindingsOallTypeSchemes _bindingsOavailablePredicates _bindingsObetaRight _bindingsObetaUnique _bindingsObetasLeft _bindingsOclassEnvironment _bindingsOcollectErrors _bindingsOcollectWarnings _bindingsOcounter _bindingsOcurrentChunk _bindingsOdictionaryEnvironment _bindingsOimportEnvironment _bindingsOmatchIO _bindingsOmonos _bindingsOnamesInScope _bindingsOorderedTypeSynonyms _bindingsOparentTree _bindingsOpatternMatchWarnings _bindingsOsubstitution _bindingsOtypeschemeMap _bindingsOuniqueChunk) + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule502 _lhsIbindingGroups _mybdggrp + _bindingsObetaUnique = rule503 _bindingsInumberOfPatterns _lhsIbetaUnique + _bindingsOmonos = rule504 _bindingsIname _lhsIinheritedBDG _lhsImonos + _beta = rule505 _lhsIbetaUnique + _betaRight = rule506 _lhsIbetaUnique + _betasLeft = rule507 _bindingsInumberOfPatterns _lhsIbetaUnique + _newcon = rule508 _beta _betaRight _betasLeft _cinfo + _mybdggrp = rule509 _beta _bindingsIassumptions _bindingsIconstraintslist _bindingsIname _lhsIbetaUnique _newcon + _declPredicates = rule510 _beta _bindingsIname _lhsIallTypeSchemes _lhsIorderedTypeSynonyms _lhsIsubstitution + _bindingsOavailablePredicates = rule511 _declPredicates _lhsIavailablePredicates + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule512 _bindingsIdictionaryEnvironment _bindingsIname _declPredicates + _bindingsOcurrentChunk = rule513 _bindingsIname _lhsIinheritedBDG + _cinfo = rule514 _bindingsInumberOfPatterns _parentTree + _localInfo = rule515 _lhsImonos _self + _parentTree = rule516 _bindingsIinfoTrees _lhsIparentTree _localInfo + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule517 _parentTree + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule518 _bindingsIname + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule519 _beta _bindingsIargcount _bindingsIelementss _bindingsIname _bindingsIpatternMatchWarnings _bindingsIunrwars _lhsIimportEnvironment _lhsIsubstitution _rangeIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule520 _bindingsIcollectInstances + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule521 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule522 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule523 _bindingsIunboundNames + _self = rule524 _bindingsIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule525 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule526 _bindingsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule527 _bindingsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule528 _bindingsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule529 _bindingsIcounter + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule530 _bindingsImatchIO + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule531 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule532 _bindingsIuniqueChunk + _bindingsOallPatterns = rule533 _lhsIallPatterns + _bindingsOallTypeSchemes = rule534 _lhsIallTypeSchemes + _bindingsObetaRight = rule535 _betaRight + _bindingsObetasLeft = rule536 _betasLeft + _bindingsOclassEnvironment = rule537 _lhsIclassEnvironment + _bindingsOcollectErrors = rule538 _lhsIcollectErrors + _bindingsOcollectWarnings = rule539 _lhsIcollectWarnings + _bindingsOcounter = rule540 _lhsIcounter + _bindingsOdictionaryEnvironment = rule541 _lhsIdictionaryEnvironment + _bindingsOimportEnvironment = rule542 _lhsIimportEnvironment + _bindingsOmatchIO = rule543 _lhsImatchIO + _bindingsOnamesInScope = rule544 _lhsInamesInScope + _bindingsOorderedTypeSynonyms = rule545 _lhsIorderedTypeSynonyms + _bindingsOparentTree = rule546 _parentTree + _bindingsOpatternMatchWarnings = rule547 _lhsIpatternMatchWarnings + _bindingsOsubstitution = rule548 _lhsIsubstitution + _bindingsOtypeschemeMap = rule549 _lhsItypeschemeMap + _bindingsOuniqueChunk = rule550 _lhsIuniqueChunk + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule502 #-} + rule502 = \ ((_lhsIbindingGroups) :: BindingGroups) _mybdggrp -> + _mybdggrp : _lhsIbindingGroups + {-# INLINE rule503 #-} + rule503 = \ ((_bindingsInumberOfPatterns) :: Int) ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 2 + _bindingsInumberOfPatterns + {-# INLINE rule504 #-} + rule504 = \ ((_bindingsIname) :: Name) ((_lhsIinheritedBDG) :: InheritedBDG) ((_lhsImonos) :: Monos) -> + findMono _bindingsIname _lhsIinheritedBDG ++ _lhsImonos + {-# INLINE rule505 #-} + rule505 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule506 #-} + rule506 = \ ((_lhsIbetaUnique) :: Int) -> + TVar (_lhsIbetaUnique + 1) + {-# INLINE rule507 #-} + rule507 = \ ((_bindingsInumberOfPatterns) :: Int) ((_lhsIbetaUnique) :: Int) -> + take _bindingsInumberOfPatterns (map TVar [_lhsIbetaUnique + 2..]) + {-# INLINE rule508 #-} + rule508 = \ _beta _betaRight _betasLeft _cinfo -> + (_beta .==. foldr (.->.) _betaRight _betasLeft) _cinfo + {-# INLINE rule509 #-} + rule509 = \ _beta ((_bindingsIassumptions) :: Assumptions) ((_bindingsIconstraintslist) :: ConstraintSets) ((_bindingsIname) :: Name) ((_lhsIbetaUnique) :: Int) _newcon -> + ( M.singleton _bindingsIname _beta + , _bindingsIassumptions + , [ Node [ Phase (-1) [_newcon] + , Receive _lhsIbetaUnique + , Node _bindingsIconstraintslist + ] + ] + ) + {-# INLINE rule510 #-} + rule510 = \ _beta ((_bindingsIname) :: Name) ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) ((_lhsIsubstitution) :: FixpointSubstitution) -> + let scheme = M.findWithDefault err (NameWithRange _bindingsIname) _lhsIallTypeSchemes + predicates = matchTypeWithScheme _lhsIorderedTypeSynonyms + (_lhsIsubstitution |-> _beta) + (_lhsIsubstitution |-> scheme) + err = internalError "TypeInferenceOverloading.ag" "n/a" "could not find type for function binding" + in expandPredicates _lhsIorderedTypeSynonyms predicates + {-# INLINE rule511 #-} + rule511 = \ _declPredicates ((_lhsIavailablePredicates) :: Predicates) -> + _declPredicates ++ _lhsIavailablePredicates + {-# INLINE rule512 #-} + rule512 = \ ((_bindingsIdictionaryEnvironment) :: DictionaryEnvironment) ((_bindingsIname) :: Name) _declPredicates -> + addForDeclaration _bindingsIname _declPredicates _bindingsIdictionaryEnvironment + {-# INLINE rule513 #-} + rule513 = \ ((_bindingsIname) :: Name) ((_lhsIinheritedBDG) :: InheritedBDG) -> + findCurrentChunk _bindingsIname _lhsIinheritedBDG + {-# INLINE rule514 #-} + rule514 = \ ((_bindingsInumberOfPatterns) :: Int) _parentTree -> + resultConstraint "function bindings (INTERNAL ERROR)" _parentTree + [ FolkloreConstraint, highlyTrusted, FuntionBindingEdge _bindingsInumberOfPatterns ] + {-# INLINE rule515 #-} + rule515 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Decl _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule516 #-} + rule516 = \ ((_bindingsIinfoTrees) :: InfoTrees) ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo _bindingsIinfoTrees + {-# INLINE rule517 #-} + rule517 = \ _parentTree -> + [_parentTree] + {-# INLINE rule518 #-} + rule518 = \ ((_bindingsIname) :: Name) -> + [_bindingsIname] + {-# INLINE rule519 #-} + rule519 = \ _beta ((_bindingsIargcount) :: Int) ((_bindingsIelementss) :: [([PatternElement], Bool)]) ((_bindingsIname) :: Name) ((_bindingsIpatternMatchWarnings) :: [Warning]) ((_bindingsIunrwars) :: [Warning]) ((_lhsIimportEnvironment) :: ImportEnvironment) ((_lhsIsubstitution) :: FixpointSubstitution) ((_rangeIself) :: Range) -> + patternMatchWarnings _lhsIimportEnvironment + _lhsIsubstitution + _beta + (take _bindingsIargcount . fst . functionSpine) + _bindingsIelementss + _rangeIself + (Just _bindingsIname) + True + _bindingsIunrwars + "function bindings" + "=" + ++ _bindingsIpatternMatchWarnings + {-# INLINE rule520 #-} + rule520 = \ ((_bindingsIcollectInstances) :: [(Name, Instance)]) -> + _bindingsIcollectInstances + {-# INLINE rule521 #-} + rule521 = \ (_ :: ()) -> + [] + {-# INLINE rule522 #-} + rule522 = \ (_ :: ()) -> + [] + {-# INLINE rule523 #-} + rule523 = \ ((_bindingsIunboundNames) :: Names) -> + _bindingsIunboundNames + {-# INLINE rule524 #-} + rule524 = \ ((_bindingsIself) :: FunctionBindings) ((_rangeIself) :: Range) -> + Declaration_FunctionBindings _rangeIself _bindingsIself + {-# INLINE rule525 #-} + rule525 = \ _self -> + _self + {-# INLINE rule526 #-} + rule526 = \ ((_bindingsIbetaUnique) :: Int) -> + _bindingsIbetaUnique + {-# INLINE rule527 #-} + rule527 = \ ((_bindingsIcollectErrors) :: TypeErrors) -> + _bindingsIcollectErrors + {-# INLINE rule528 #-} + rule528 = \ ((_bindingsIcollectWarnings) :: Warnings) -> + _bindingsIcollectWarnings + {-# INLINE rule529 #-} + rule529 = \ ((_bindingsIcounter) :: Int) -> + _bindingsIcounter + {-# INLINE rule530 #-} + rule530 = \ ((_bindingsImatchIO) :: IO ()) -> + _bindingsImatchIO + {-# INLINE rule531 #-} + rule531 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule532 #-} + rule532 = \ ((_bindingsIuniqueChunk) :: Int) -> + _bindingsIuniqueChunk + {-# INLINE rule533 #-} + rule533 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule534 #-} + rule534 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule535 #-} + rule535 = \ _betaRight -> + _betaRight + {-# INLINE rule536 #-} + rule536 = \ _betasLeft -> + _betasLeft + {-# INLINE rule537 #-} + rule537 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule538 #-} + rule538 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule539 #-} + rule539 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule540 #-} + rule540 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule541 #-} + rule541 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule542 #-} + rule542 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule543 #-} + rule543 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule544 #-} + rule544 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule545 #-} + rule545 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule546 #-} + rule546 = \ _parentTree -> + _parentTree + {-# INLINE rule547 #-} + rule547 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule548 #-} + rule548 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule549 #-} + rule549 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule550 #-} + rule550 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Declaration_PatternBinding #-} +sem_Declaration_PatternBinding :: T_Range -> T_Pattern -> T_RightHandSide -> T_Declaration +sem_Declaration_PatternBinding arg_range_ arg_pattern_ arg_righthandside_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIbeta _patternIbetaUnique _patternIconstraints _patternIcounter _patternIelements _patternIenvironment _patternIinfoTree _patternIpatVarNames _patternIpatternMatchWarnings _patternIself _patternIunboundNames) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternObetaUnique _patternOcounter _patternOimportEnvironment _patternOmonos _patternOnamesInScope _patternOparentTree _patternOpatternMatchWarnings) + (T_RightHandSide_vOut148 _righthandsideIassumptions _righthandsideIbetaUnique _righthandsideIcollectErrors _righthandsideIcollectInstances _righthandsideIcollectWarnings _righthandsideIconstraints _righthandsideIcounter _righthandsideIdictionaryEnvironment _righthandsideIfallthrough _righthandsideIinfoTree _righthandsideImatchIO _righthandsideIpatternMatchWarnings _righthandsideIself _righthandsideIunboundNames _righthandsideIuniqueChunk) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOallPatterns _righthandsideOallTypeSchemes _righthandsideOavailablePredicates _righthandsideObetaRight _righthandsideObetaUnique _righthandsideOclassEnvironment _righthandsideOcollectErrors _righthandsideOcollectWarnings _righthandsideOcounter _righthandsideOcurrentChunk _righthandsideOdictionaryEnvironment _righthandsideOimportEnvironment _righthandsideOmatchIO _righthandsideOmonos _righthandsideOnamesInScope _righthandsideOorderedTypeSynonyms _righthandsideOparentTree _righthandsideOpatternMatchWarnings _righthandsideOsubstitution _righthandsideOtypeschemeMap _righthandsideOuniqueChunk) + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule551 _lhsIbindingGroups _mybdggrp + _patternObetaUnique = rule552 _lhsIbetaUnique + _righthandsideOmonos = rule553 _lhsIinheritedBDG _lhsImonos _patternIenvironment + _betaRight = rule554 _lhsIbetaUnique + _newcon = rule555 _betaRight _cinfo _patternIbeta + _mybdggrp = rule556 _newcon _patternIconstraints _patternIenvironment _righthandsideIassumptions _righthandsideIconstraints + _declPredicates = rule557 _betaRight _lhsIallTypeSchemes _lhsIorderedTypeSynonyms _lhsIsubstitution _patternIself + _righthandsideOavailablePredicates = rule558 _declPredicates _lhsIavailablePredicates + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule559 _declPredicates _righthandsideIdictionaryEnvironment + _lhsOrestrictedNames :: Names + _lhsOsimplePatNames :: Names + (_lhsOrestrictedNames,_lhsOsimplePatNames) = rule560 _patternIpatVarNames _patternIself + _righthandsideOcurrentChunk = rule561 _lhsIinheritedBDG _patternIenvironment + _cinfo = rule562 _parentTree + _localInfo = rule563 _lhsImonos _self + _parentTree = rule564 _lhsIparentTree _localInfo _patternIinfoTree _righthandsideIinfoTree + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule565 _parentTree + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule566 _patternIpatVarNames + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule567 _lhsIimportEnvironment _lhsIsubstitution _patternIbeta _patternIelements _rangeIself _righthandsideIfallthrough _righthandsideIpatternMatchWarnings + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule568 _righthandsideIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule569 _patternIunboundNames _righthandsideIunboundNames + _self = rule570 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Declaration + _lhsOself = rule571 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule572 _righthandsideIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule573 _righthandsideIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule574 _righthandsideIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule575 _righthandsideIcounter + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule576 _righthandsideImatchIO + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule577 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule578 _righthandsideIuniqueChunk + _patternOcounter = rule579 _lhsIcounter + _patternOimportEnvironment = rule580 _lhsIimportEnvironment + _patternOmonos = rule581 _lhsImonos + _patternOnamesInScope = rule582 _lhsInamesInScope + _patternOparentTree = rule583 _parentTree + _patternOpatternMatchWarnings = rule584 _lhsIpatternMatchWarnings + _righthandsideOallPatterns = rule585 _lhsIallPatterns + _righthandsideOallTypeSchemes = rule586 _lhsIallTypeSchemes + _righthandsideObetaRight = rule587 _betaRight + _righthandsideObetaUnique = rule588 _patternIbetaUnique + _righthandsideOclassEnvironment = rule589 _lhsIclassEnvironment + _righthandsideOcollectErrors = rule590 _lhsIcollectErrors + _righthandsideOcollectWarnings = rule591 _lhsIcollectWarnings + _righthandsideOcounter = rule592 _patternIcounter + _righthandsideOdictionaryEnvironment = rule593 _lhsIdictionaryEnvironment + _righthandsideOimportEnvironment = rule594 _lhsIimportEnvironment + _righthandsideOmatchIO = rule595 _lhsImatchIO + _righthandsideOnamesInScope = rule596 _lhsInamesInScope + _righthandsideOorderedTypeSynonyms = rule597 _lhsIorderedTypeSynonyms + _righthandsideOparentTree = rule598 _parentTree + _righthandsideOpatternMatchWarnings = rule599 _patternIpatternMatchWarnings + _righthandsideOsubstitution = rule600 _lhsIsubstitution + _righthandsideOtypeschemeMap = rule601 _lhsItypeschemeMap + _righthandsideOuniqueChunk = rule602 _lhsIuniqueChunk + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule551 #-} + rule551 = \ ((_lhsIbindingGroups) :: BindingGroups) _mybdggrp -> + _mybdggrp : _lhsIbindingGroups + {-# INLINE rule552 #-} + rule552 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule553 #-} + rule553 = \ ((_lhsIinheritedBDG) :: InheritedBDG) ((_lhsImonos) :: Monos) ((_patternIenvironment) :: PatternAssumptions) -> + findMono (head (M.keys _patternIenvironment)) _lhsIinheritedBDG ++ _lhsImonos + {-# INLINE rule554 #-} + rule554 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule555 #-} + rule555 = \ _betaRight _cinfo ((_patternIbeta) :: Tp) -> + [ (_betaRight .==. _patternIbeta) _cinfo ] + {-# INLINE rule556 #-} + rule556 = \ _newcon ((_patternIconstraints) :: ConstraintSet) ((_patternIenvironment) :: PatternAssumptions) ((_righthandsideIassumptions) :: Assumptions) ((_righthandsideIconstraints) :: ConstraintSet) -> + ( _patternIenvironment + , _righthandsideIassumptions + , [ _newcon .>. + Node [ _patternIconstraints + , _righthandsideIconstraints + ] + ] + ) + {-# INLINE rule557 #-} + rule557 = \ _betaRight ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) ((_lhsIsubstitution) :: FixpointSubstitution) ((_patternIself) :: Pattern) -> + case _patternIself of + Pattern_Variable _ name -> + let scheme = M.findWithDefault err (NameWithRange name) _lhsIallTypeSchemes + predicates = matchTypeWithScheme _lhsIorderedTypeSynonyms + (_lhsIsubstitution |-> _betaRight) + (_lhsIsubstitution |-> scheme) + err = internalError "TypeInferenceOverloading.ag" "n/a" ("could not find type for pattern binding "++show name) + in Just (name, expandPredicates _lhsIorderedTypeSynonyms predicates) + _ -> Nothing + {-# INLINE rule558 #-} + rule558 = \ _declPredicates ((_lhsIavailablePredicates) :: Predicates) -> + case _declPredicates of + Just (_, ps) -> ps ++ _lhsIavailablePredicates + Nothing -> _lhsIavailablePredicates + {-# INLINE rule559 #-} + rule559 = \ _declPredicates ((_righthandsideIdictionaryEnvironment) :: DictionaryEnvironment) -> + case _declPredicates of + Just (n, ps) -> addForDeclaration n ps _righthandsideIdictionaryEnvironment + Nothing -> _righthandsideIdictionaryEnvironment + {-# INLINE rule560 #-} + rule560 = \ ((_patternIpatVarNames) :: Names) ((_patternIself) :: Pattern) -> + if isSimplePattern _patternIself + then ([], _patternIpatVarNames) + else (_patternIpatVarNames, []) + {-# INLINE rule561 #-} + rule561 = \ ((_lhsIinheritedBDG) :: InheritedBDG) ((_patternIenvironment) :: PatternAssumptions) -> + findCurrentChunk (head (M.keys _patternIenvironment)) _lhsIinheritedBDG + {-# INLINE rule562 #-} + rule562 = \ _parentTree -> + orphanConstraint 1 "right hand side" _parentTree + [] + {-# INLINE rule563 #-} + rule563 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Decl _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule564 #-} + rule564 = \ ((_lhsIparentTree) :: InfoTree) _localInfo ((_patternIinfoTree) :: InfoTree) ((_righthandsideIinfoTree) :: InfoTree) -> + node _lhsIparentTree _localInfo [_patternIinfoTree, _righthandsideIinfoTree] + {-# INLINE rule565 #-} + rule565 = \ _parentTree -> + [_parentTree] + {-# INLINE rule566 #-} + rule566 = \ ((_patternIpatVarNames) :: Names) -> + _patternIpatVarNames + {-# INLINE rule567 #-} + rule567 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) ((_lhsIsubstitution) :: FixpointSubstitution) ((_patternIbeta) :: Tp) ((_patternIelements) :: [PatternElement] ) ((_rangeIself) :: Range) ((_righthandsideIfallthrough) :: Bool) ((_righthandsideIpatternMatchWarnings) :: [Warning]) -> + patternMatchWarnings _lhsIimportEnvironment + _lhsIsubstitution + _patternIbeta + (:[]) + [(_patternIelements, _righthandsideIfallthrough)] + _rangeIself + Nothing + False + [] + "pattern binding" + "=" + ++ _righthandsideIpatternMatchWarnings + {-# INLINE rule568 #-} + rule568 = \ ((_righthandsideIcollectInstances) :: [(Name, Instance)]) -> + _righthandsideIcollectInstances + {-# INLINE rule569 #-} + rule569 = \ ((_patternIunboundNames) :: Names) ((_righthandsideIunboundNames) :: Names) -> + _patternIunboundNames ++ _righthandsideIunboundNames + {-# INLINE rule570 #-} + rule570 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Declaration_PatternBinding _rangeIself _patternIself _righthandsideIself + {-# INLINE rule571 #-} + rule571 = \ _self -> + _self + {-# INLINE rule572 #-} + rule572 = \ ((_righthandsideIbetaUnique) :: Int) -> + _righthandsideIbetaUnique + {-# INLINE rule573 #-} + rule573 = \ ((_righthandsideIcollectErrors) :: TypeErrors) -> + _righthandsideIcollectErrors + {-# INLINE rule574 #-} + rule574 = \ ((_righthandsideIcollectWarnings) :: Warnings) -> + _righthandsideIcollectWarnings + {-# INLINE rule575 #-} + rule575 = \ ((_righthandsideIcounter) :: Int) -> + _righthandsideIcounter + {-# INLINE rule576 #-} + rule576 = \ ((_righthandsideImatchIO) :: IO ()) -> + _righthandsideImatchIO + {-# INLINE rule577 #-} + rule577 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule578 #-} + rule578 = \ ((_righthandsideIuniqueChunk) :: Int) -> + _righthandsideIuniqueChunk + {-# INLINE rule579 #-} + rule579 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule580 #-} + rule580 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule581 #-} + rule581 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule582 #-} + rule582 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule583 #-} + rule583 = \ _parentTree -> + _parentTree + {-# INLINE rule584 #-} + rule584 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule585 #-} + rule585 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule586 #-} + rule586 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule587 #-} + rule587 = \ _betaRight -> + _betaRight + {-# INLINE rule588 #-} + rule588 = \ ((_patternIbetaUnique) :: Int) -> + _patternIbetaUnique + {-# INLINE rule589 #-} + rule589 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule590 #-} + rule590 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule591 #-} + rule591 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule592 #-} + rule592 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule593 #-} + rule593 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule594 #-} + rule594 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule595 #-} + rule595 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule596 #-} + rule596 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule597 #-} + rule597 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule598 #-} + rule598 = \ _parentTree -> + _parentTree + {-# INLINE rule599 #-} + rule599 = \ ((_patternIpatternMatchWarnings) :: [Warning]) -> + _patternIpatternMatchWarnings + {-# INLINE rule600 #-} + rule600 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule601 #-} + rule601 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule602 #-} + rule602 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Declaration_TypeSignature #-} +sem_Declaration_TypeSignature :: T_Range -> T_Names -> T_Type -> T_Declaration +sem_Declaration_TypeSignature arg_range_ arg_names_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule603 _lhsItypeSignatures _namesIself _typeScheme + _typeScheme = rule604 _typeIself + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule605 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule606 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule607 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule608 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule609 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule610 () + _self = rule611 _namesIself _rangeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule612 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule613 _lhsIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule614 _lhsIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule615 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule616 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule617 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule618 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule619 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule620 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule621 _lhsIuniqueChunk + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule603 #-} + rule603 = \ ((_lhsItypeSignatures) :: TypeEnvironment) ((_namesIself) :: Names) _typeScheme -> + _lhsItypeSignatures `M.union` (M.fromList [ (name, _typeScheme) | name <- _namesIself ]) + {-# INLINE rule604 #-} + rule604 = \ ((_typeIself) :: Type) -> + makeTpSchemeFromType _typeIself + {-# INLINE rule605 #-} + rule605 = \ (_ :: ()) -> + [] + {-# INLINE rule606 #-} + rule606 = \ (_ :: ()) -> + [] + {-# INLINE rule607 #-} + rule607 = \ (_ :: ()) -> + [] + {-# INLINE rule608 #-} + rule608 = \ (_ :: ()) -> + [] + {-# INLINE rule609 #-} + rule609 = \ (_ :: ()) -> + [] + {-# INLINE rule610 #-} + rule610 = \ (_ :: ()) -> + [] + {-# INLINE rule611 #-} + rule611 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Declaration_TypeSignature _rangeIself _namesIself _typeIself + {-# INLINE rule612 #-} + rule612 = \ _self -> + _self + {-# INLINE rule613 #-} + rule613 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule614 #-} + rule614 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule615 #-} + rule615 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule616 #-} + rule616 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule617 #-} + rule617 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule618 #-} + rule618 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule619 #-} + rule619 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule620 #-} + rule620 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule621 #-} + rule621 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Declaration_Fixity #-} +sem_Declaration_Fixity :: T_Range -> T_Fixity -> T_MaybeInt -> T_Names -> T_Declaration +sem_Declaration_Fixity arg_range_ arg_fixity_ arg_priority_ arg_operators_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fixityX53 = Control.Monad.Identity.runIdentity (attach_T_Fixity (arg_fixity_)) + _priorityX101 = Control.Monad.Identity.runIdentity (attach_T_MaybeInt (arg_priority_)) + _operatorsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_operators_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Fixity_vOut52 _fixityIself) = inv_Fixity_s53 _fixityX53 (T_Fixity_vIn52 ) + (T_MaybeInt_vOut100 _priorityIself) = inv_MaybeInt_s101 _priorityX101 (T_MaybeInt_vIn100 ) + (T_Names_vOut115 _operatorsIself) = inv_Names_s116 _operatorsX116 (T_Names_vIn115 ) + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule622 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule623 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule624 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule625 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule626 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule627 () + _self = rule628 _fixityIself _operatorsIself _priorityIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule629 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule630 _lhsIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule631 _lhsIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule632 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule633 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule634 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule635 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule636 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule637 _lhsIpatternMatchWarnings + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule638 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule639 _lhsIuniqueChunk + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule622 #-} + rule622 = \ (_ :: ()) -> + [] + {-# INLINE rule623 #-} + rule623 = \ (_ :: ()) -> + [] + {-# INLINE rule624 #-} + rule624 = \ (_ :: ()) -> + [] + {-# INLINE rule625 #-} + rule625 = \ (_ :: ()) -> + [] + {-# INLINE rule626 #-} + rule626 = \ (_ :: ()) -> + [] + {-# INLINE rule627 #-} + rule627 = \ (_ :: ()) -> + [] + {-# INLINE rule628 #-} + rule628 = \ ((_fixityIself) :: Fixity) ((_operatorsIself) :: Names) ((_priorityIself) :: MaybeInt) ((_rangeIself) :: Range) -> + Declaration_Fixity _rangeIself _fixityIself _priorityIself _operatorsIself + {-# INLINE rule629 #-} + rule629 = \ _self -> + _self + {-# INLINE rule630 #-} + rule630 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule631 #-} + rule631 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule632 #-} + rule632 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule633 #-} + rule633 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule634 #-} + rule634 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule635 #-} + rule635 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule636 #-} + rule636 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule637 #-} + rule637 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule638 #-} + rule638 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule639 #-} + rule639 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Declaration_Empty #-} +sem_Declaration_Empty :: T_Range -> T_Declaration +sem_Declaration_Empty arg_range_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule640 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule641 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule642 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule643 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule644 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule645 () + _self = rule646 _rangeIself + _lhsOself :: Declaration + _lhsOself = rule647 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule648 _lhsIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule649 _lhsIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule650 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule651 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule652 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule653 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule654 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule655 _lhsIpatternMatchWarnings + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule656 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule657 _lhsIuniqueChunk + __result_ = T_Declaration_vOut28 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule640 #-} + rule640 = \ (_ :: ()) -> + [] + {-# INLINE rule641 #-} + rule641 = \ (_ :: ()) -> + [] + {-# INLINE rule642 #-} + rule642 = \ (_ :: ()) -> + [] + {-# INLINE rule643 #-} + rule643 = \ (_ :: ()) -> + [] + {-# INLINE rule644 #-} + rule644 = \ (_ :: ()) -> + [] + {-# INLINE rule645 #-} + rule645 = \ (_ :: ()) -> + [] + {-# INLINE rule646 #-} + rule646 = \ ((_rangeIself) :: Range) -> + Declaration_Empty _rangeIself + {-# INLINE rule647 #-} + rule647 = \ _self -> + _self + {-# INLINE rule648 #-} + rule648 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule649 #-} + rule649 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule650 #-} + rule650 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule651 #-} + rule651 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule652 #-} + rule652 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule653 #-} + rule653 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule654 #-} + rule654 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule655 #-} + rule655 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule656 #-} + rule656 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule657 #-} + rule657 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + +-- Declarations ------------------------------------------------ +-- wrapper +data Inh_Declarations = Inh_Declarations { allPatterns_Inh_Declarations :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_Declarations :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_Declarations :: (Predicates), betaUnique_Inh_Declarations :: (Int), bindingGroups_Inh_Declarations :: (BindingGroups), classEnvironment_Inh_Declarations :: (ClassEnvironment), collectErrors_Inh_Declarations :: (TypeErrors), collectWarnings_Inh_Declarations :: (Warnings), counter_Inh_Declarations :: (Int), currentChunk_Inh_Declarations :: (Int), dictionaryEnvironment_Inh_Declarations :: (DictionaryEnvironment), importEnvironment_Inh_Declarations :: (ImportEnvironment), inheritedBDG_Inh_Declarations :: (InheritedBDG), matchIO_Inh_Declarations :: (IO ()), monos_Inh_Declarations :: (Monos), namesInScope_Inh_Declarations :: (Names), orderedTypeSynonyms_Inh_Declarations :: (OrderedTypeSynonyms), parentTree_Inh_Declarations :: (InfoTree), patternMatchWarnings_Inh_Declarations :: ([Warning]), substitution_Inh_Declarations :: (FixpointSubstitution), typeSignatures_Inh_Declarations :: (TypeEnvironment), typeschemeMap_Inh_Declarations :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_Declarations :: (Int) } +data Syn_Declarations = Syn_Declarations { betaUnique_Syn_Declarations :: (Int), bindingGroups_Syn_Declarations :: (BindingGroups), collectErrors_Syn_Declarations :: (TypeErrors), collectInstances_Syn_Declarations :: ([(Name, Instance)]), collectWarnings_Syn_Declarations :: (Warnings), counter_Syn_Declarations :: (Int), declVarNames_Syn_Declarations :: (Names), dictionaryEnvironment_Syn_Declarations :: (DictionaryEnvironment), infoTrees_Syn_Declarations :: (InfoTrees), matchIO_Syn_Declarations :: (IO ()), patternMatchWarnings_Syn_Declarations :: ([Warning]), restrictedNames_Syn_Declarations :: (Names), self_Syn_Declarations :: (Declarations), simplePatNames_Syn_Declarations :: (Names), typeSignatures_Syn_Declarations :: (TypeEnvironment), unboundNames_Syn_Declarations :: (Names), uniqueChunk_Syn_Declarations :: (Int) } +{-# INLINABLE wrap_Declarations #-} +wrap_Declarations :: T_Declarations -> Inh_Declarations -> (Syn_Declarations ) +wrap_Declarations (T_Declarations act) (Inh_Declarations _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declarations_vIn31 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk + (T_Declarations_vOut31 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk) <- return (inv_Declarations_s32 sem arg) + return (Syn_Declarations _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk) + ) + +-- cata +{-# NOINLINE sem_Declarations #-} +sem_Declarations :: Declarations -> T_Declarations +sem_Declarations list = Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list) + +-- semantic domain +newtype T_Declarations = T_Declarations { + attach_T_Declarations :: Identity (T_Declarations_s32 ) + } +newtype T_Declarations_s32 = C_Declarations_s32 { + inv_Declarations_s32 :: (T_Declarations_v31 ) + } +data T_Declarations_s33 = C_Declarations_s33 +type T_Declarations_v31 = (T_Declarations_vIn31 ) -> (T_Declarations_vOut31 ) +data T_Declarations_vIn31 = T_Declarations_vIn31 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Int) (BindingGroups) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (InheritedBDG) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (TypeEnvironment) (M.Map Int (Scheme Predicates)) (Int) +data T_Declarations_vOut31 = T_Declarations_vOut31 (Int) (BindingGroups) (TypeErrors) ([(Name, Instance)]) (Warnings) (Int) (Names) (DictionaryEnvironment) (InfoTrees) (IO ()) ([Warning]) (Names) (Declarations) (Names) (TypeEnvironment) (Names) (Int) +{-# NOINLINE sem_Declarations_Cons #-} +sem_Declarations_Cons :: T_Declaration -> T_Declarations -> T_Declarations +sem_Declarations_Cons arg_hd_ arg_tl_ = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Declaration (arg_hd_)) + _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_tl_)) + (T_Declaration_vOut28 _hdIbetaUnique _hdIbindingGroups _hdIcollectErrors _hdIcollectInstances _hdIcollectWarnings _hdIcounter _hdIdeclVarNames _hdIdictionaryEnvironment _hdIinfoTrees _hdImatchIO _hdIpatternMatchWarnings _hdIrestrictedNames _hdIself _hdIsimplePatNames _hdItypeSignatures _hdIunboundNames _hdIuniqueChunk) = inv_Declaration_s29 _hdX29 (T_Declaration_vIn28 _hdOallPatterns _hdOallTypeSchemes _hdOavailablePredicates _hdObetaUnique _hdObindingGroups _hdOclassEnvironment _hdOcollectErrors _hdOcollectWarnings _hdOcounter _hdOcurrentChunk _hdOdictionaryEnvironment _hdOimportEnvironment _hdOinheritedBDG _hdOmatchIO _hdOmonos _hdOnamesInScope _hdOorderedTypeSynonyms _hdOparentTree _hdOpatternMatchWarnings _hdOsubstitution _hdOtypeSignatures _hdOtypeschemeMap _hdOuniqueChunk) + (T_Declarations_vOut31 _tlIbetaUnique _tlIbindingGroups _tlIcollectErrors _tlIcollectInstances _tlIcollectWarnings _tlIcounter _tlIdeclVarNames _tlIdictionaryEnvironment _tlIinfoTrees _tlImatchIO _tlIpatternMatchWarnings _tlIrestrictedNames _tlIself _tlIsimplePatNames _tlItypeSignatures _tlIunboundNames _tlIuniqueChunk) = inv_Declarations_s32 _tlX32 (T_Declarations_vIn31 _tlOallPatterns _tlOallTypeSchemes _tlOavailablePredicates _tlObetaUnique _tlObindingGroups _tlOclassEnvironment _tlOcollectErrors _tlOcollectWarnings _tlOcounter _tlOcurrentChunk _tlOdictionaryEnvironment _tlOimportEnvironment _tlOinheritedBDG _tlOmatchIO _tlOmonos _tlOnamesInScope _tlOorderedTypeSynonyms _tlOparentTree _tlOpatternMatchWarnings _tlOsubstitution _tlOtypeSignatures _tlOtypeschemeMap _tlOuniqueChunk) + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule658 _hdIinfoTrees _tlIinfoTrees + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule659 _hdIcollectInstances _tlIcollectInstances + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule660 _hdIdeclVarNames _tlIdeclVarNames + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule661 _hdIrestrictedNames _tlIrestrictedNames + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule662 _hdIsimplePatNames _tlIsimplePatNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule663 _hdIunboundNames _tlIunboundNames + _self = rule664 _hdIself _tlIself + _lhsOself :: Declarations + _lhsOself = rule665 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule666 _tlIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule667 _tlIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule668 _tlIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule669 _tlIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule670 _tlIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule671 _tlIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule672 _tlImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule673 _tlIpatternMatchWarnings + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule674 _tlItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule675 _tlIuniqueChunk + _hdOallPatterns = rule676 _lhsIallPatterns + _hdOallTypeSchemes = rule677 _lhsIallTypeSchemes + _hdOavailablePredicates = rule678 _lhsIavailablePredicates + _hdObetaUnique = rule679 _lhsIbetaUnique + _hdObindingGroups = rule680 _lhsIbindingGroups + _hdOclassEnvironment = rule681 _lhsIclassEnvironment + _hdOcollectErrors = rule682 _lhsIcollectErrors + _hdOcollectWarnings = rule683 _lhsIcollectWarnings + _hdOcounter = rule684 _lhsIcounter + _hdOcurrentChunk = rule685 _lhsIcurrentChunk + _hdOdictionaryEnvironment = rule686 _lhsIdictionaryEnvironment + _hdOimportEnvironment = rule687 _lhsIimportEnvironment + _hdOinheritedBDG = rule688 _lhsIinheritedBDG + _hdOmatchIO = rule689 _lhsImatchIO + _hdOmonos = rule690 _lhsImonos + _hdOnamesInScope = rule691 _lhsInamesInScope + _hdOorderedTypeSynonyms = rule692 _lhsIorderedTypeSynonyms + _hdOparentTree = rule693 _lhsIparentTree + _hdOpatternMatchWarnings = rule694 _lhsIpatternMatchWarnings + _hdOsubstitution = rule695 _lhsIsubstitution + _hdOtypeSignatures = rule696 _lhsItypeSignatures + _hdOtypeschemeMap = rule697 _lhsItypeschemeMap + _hdOuniqueChunk = rule698 _lhsIuniqueChunk + _tlOallPatterns = rule699 _lhsIallPatterns + _tlOallTypeSchemes = rule700 _lhsIallTypeSchemes + _tlOavailablePredicates = rule701 _lhsIavailablePredicates + _tlObetaUnique = rule702 _hdIbetaUnique + _tlObindingGroups = rule703 _hdIbindingGroups + _tlOclassEnvironment = rule704 _lhsIclassEnvironment + _tlOcollectErrors = rule705 _hdIcollectErrors + _tlOcollectWarnings = rule706 _hdIcollectWarnings + _tlOcounter = rule707 _hdIcounter + _tlOcurrentChunk = rule708 _lhsIcurrentChunk + _tlOdictionaryEnvironment = rule709 _hdIdictionaryEnvironment + _tlOimportEnvironment = rule710 _lhsIimportEnvironment + _tlOinheritedBDG = rule711 _lhsIinheritedBDG + _tlOmatchIO = rule712 _hdImatchIO + _tlOmonos = rule713 _lhsImonos + _tlOnamesInScope = rule714 _lhsInamesInScope + _tlOorderedTypeSynonyms = rule715 _lhsIorderedTypeSynonyms + _tlOparentTree = rule716 _lhsIparentTree + _tlOpatternMatchWarnings = rule717 _hdIpatternMatchWarnings + _tlOsubstitution = rule718 _lhsIsubstitution + _tlOtypeSignatures = rule719 _hdItypeSignatures + _tlOtypeschemeMap = rule720 _lhsItypeschemeMap + _tlOuniqueChunk = rule721 _hdIuniqueChunk + __result_ = T_Declarations_vOut31 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule658 #-} + rule658 = \ ((_hdIinfoTrees) :: InfoTrees) ((_tlIinfoTrees) :: InfoTrees) -> + _hdIinfoTrees ++ _tlIinfoTrees + {-# INLINE rule659 #-} + rule659 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule660 #-} + rule660 = \ ((_hdIdeclVarNames) :: Names) ((_tlIdeclVarNames) :: Names) -> + _hdIdeclVarNames ++ _tlIdeclVarNames + {-# INLINE rule661 #-} + rule661 = \ ((_hdIrestrictedNames) :: Names) ((_tlIrestrictedNames) :: Names) -> + _hdIrestrictedNames ++ _tlIrestrictedNames + {-# INLINE rule662 #-} + rule662 = \ ((_hdIsimplePatNames) :: Names) ((_tlIsimplePatNames) :: Names) -> + _hdIsimplePatNames ++ _tlIsimplePatNames + {-# INLINE rule663 #-} + rule663 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule664 #-} + rule664 = \ ((_hdIself) :: Declaration) ((_tlIself) :: Declarations) -> + (:) _hdIself _tlIself + {-# INLINE rule665 #-} + rule665 = \ _self -> + _self + {-# INLINE rule666 #-} + rule666 = \ ((_tlIbetaUnique) :: Int) -> + _tlIbetaUnique + {-# INLINE rule667 #-} + rule667 = \ ((_tlIbindingGroups) :: BindingGroups) -> + _tlIbindingGroups + {-# INLINE rule668 #-} + rule668 = \ ((_tlIcollectErrors) :: TypeErrors) -> + _tlIcollectErrors + {-# INLINE rule669 #-} + rule669 = \ ((_tlIcollectWarnings) :: Warnings) -> + _tlIcollectWarnings + {-# INLINE rule670 #-} + rule670 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule671 #-} + rule671 = \ ((_tlIdictionaryEnvironment) :: DictionaryEnvironment) -> + _tlIdictionaryEnvironment + {-# INLINE rule672 #-} + rule672 = \ ((_tlImatchIO) :: IO ()) -> + _tlImatchIO + {-# INLINE rule673 #-} + rule673 = \ ((_tlIpatternMatchWarnings) :: [Warning]) -> + _tlIpatternMatchWarnings + {-# INLINE rule674 #-} + rule674 = \ ((_tlItypeSignatures) :: TypeEnvironment) -> + _tlItypeSignatures + {-# INLINE rule675 #-} + rule675 = \ ((_tlIuniqueChunk) :: Int) -> + _tlIuniqueChunk + {-# INLINE rule676 #-} + rule676 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule677 #-} + rule677 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule678 #-} + rule678 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule679 #-} + rule679 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule680 #-} + rule680 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule681 #-} + rule681 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule682 #-} + rule682 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule683 #-} + rule683 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule684 #-} + rule684 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule685 #-} + rule685 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule686 #-} + rule686 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule687 #-} + rule687 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule688 #-} + rule688 = \ ((_lhsIinheritedBDG) :: InheritedBDG) -> + _lhsIinheritedBDG + {-# INLINE rule689 #-} + rule689 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule690 #-} + rule690 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule691 #-} + rule691 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule692 #-} + rule692 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule693 #-} + rule693 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule694 #-} + rule694 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule695 #-} + rule695 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule696 #-} + rule696 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule697 #-} + rule697 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule698 #-} + rule698 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule699 #-} + rule699 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule700 #-} + rule700 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule701 #-} + rule701 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule702 #-} + rule702 = \ ((_hdIbetaUnique) :: Int) -> + _hdIbetaUnique + {-# INLINE rule703 #-} + rule703 = \ ((_hdIbindingGroups) :: BindingGroups) -> + _hdIbindingGroups + {-# INLINE rule704 #-} + rule704 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule705 #-} + rule705 = \ ((_hdIcollectErrors) :: TypeErrors) -> + _hdIcollectErrors + {-# INLINE rule706 #-} + rule706 = \ ((_hdIcollectWarnings) :: Warnings) -> + _hdIcollectWarnings + {-# INLINE rule707 #-} + rule707 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule708 #-} + rule708 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule709 #-} + rule709 = \ ((_hdIdictionaryEnvironment) :: DictionaryEnvironment) -> + _hdIdictionaryEnvironment + {-# INLINE rule710 #-} + rule710 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule711 #-} + rule711 = \ ((_lhsIinheritedBDG) :: InheritedBDG) -> + _lhsIinheritedBDG + {-# INLINE rule712 #-} + rule712 = \ ((_hdImatchIO) :: IO ()) -> + _hdImatchIO + {-# INLINE rule713 #-} + rule713 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule714 #-} + rule714 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule715 #-} + rule715 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule716 #-} + rule716 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule717 #-} + rule717 = \ ((_hdIpatternMatchWarnings) :: [Warning]) -> + _hdIpatternMatchWarnings + {-# INLINE rule718 #-} + rule718 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule719 #-} + rule719 = \ ((_hdItypeSignatures) :: TypeEnvironment) -> + _hdItypeSignatures + {-# INLINE rule720 #-} + rule720 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule721 #-} + rule721 = \ ((_hdIuniqueChunk) :: Int) -> + _hdIuniqueChunk +{-# NOINLINE sem_Declarations_Nil #-} +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIbindingGroups _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsIinheritedBDG _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeSignatures _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule722 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule723 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule724 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule725 () + _lhsOsimplePatNames :: Names + _lhsOsimplePatNames = rule726 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule727 () + _self = rule728 () + _lhsOself :: Declarations + _lhsOself = rule729 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule730 _lhsIbetaUnique + _lhsObindingGroups :: BindingGroups + _lhsObindingGroups = rule731 _lhsIbindingGroups + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule732 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule733 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule734 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule735 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule736 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule737 _lhsIpatternMatchWarnings + _lhsOtypeSignatures :: TypeEnvironment + _lhsOtypeSignatures = rule738 _lhsItypeSignatures + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule739 _lhsIuniqueChunk + __result_ = T_Declarations_vOut31 _lhsObetaUnique _lhsObindingGroups _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdeclVarNames _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrestrictedNames _lhsOself _lhsOsimplePatNames _lhsOtypeSignatures _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule722 #-} + rule722 = \ (_ :: ()) -> + [] + {-# INLINE rule723 #-} + rule723 = \ (_ :: ()) -> + [] + {-# INLINE rule724 #-} + rule724 = \ (_ :: ()) -> + [] + {-# INLINE rule725 #-} + rule725 = \ (_ :: ()) -> + [] + {-# INLINE rule726 #-} + rule726 = \ (_ :: ()) -> + [] + {-# INLINE rule727 #-} + rule727 = \ (_ :: ()) -> + [] + {-# INLINE rule728 #-} + rule728 = \ (_ :: ()) -> + [] + {-# INLINE rule729 #-} + rule729 = \ _self -> + _self + {-# INLINE rule730 #-} + rule730 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule731 #-} + rule731 = \ ((_lhsIbindingGroups) :: BindingGroups) -> + _lhsIbindingGroups + {-# INLINE rule732 #-} + rule732 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule733 #-} + rule733 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule734 #-} + rule734 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule735 #-} + rule735 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule736 #-} + rule736 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule737 #-} + rule737 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule738 #-} + rule738 = \ ((_lhsItypeSignatures) :: TypeEnvironment) -> + _lhsItypeSignatures + {-# INLINE rule739 #-} + rule739 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + +-- Export ------------------------------------------------------ +-- wrapper +data Inh_Export = Inh_Export { } +data Syn_Export = Syn_Export { self_Syn_Export :: (Export) } +{-# INLINABLE wrap_Export #-} +wrap_Export :: T_Export -> Inh_Export -> (Syn_Export ) +wrap_Export (T_Export act) (Inh_Export ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Export_vIn34 + (T_Export_vOut34 _lhsOself) <- return (inv_Export_s35 sem arg) + return (Syn_Export _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Export #-} +sem_Export :: Export -> T_Export +sem_Export ( Export_Variable range_ name_ ) = sem_Export_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_TypeOrClass range_ name_ names_ ) = sem_Export_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Export ( Export_TypeOrClassComplete range_ name_ ) = sem_Export_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_Module range_ name_ ) = sem_Export_Module ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Export = T_Export { + attach_T_Export :: Identity (T_Export_s35 ) + } +newtype T_Export_s35 = C_Export_s35 { + inv_Export_s35 :: (T_Export_v34 ) + } +data T_Export_s36 = C_Export_s36 +type T_Export_v34 = (T_Export_vIn34 ) -> (T_Export_vOut34 ) +data T_Export_vIn34 = T_Export_vIn34 +data T_Export_vOut34 = T_Export_vOut34 (Export) +{-# NOINLINE sem_Export_Variable #-} +sem_Export_Variable :: T_Range -> T_Name -> T_Export +sem_Export_Variable arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule740 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule741 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule740 #-} + rule740 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Variable _rangeIself _nameIself + {-# INLINE rule741 #-} + rule741 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClass #-} +sem_Export_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Export +sem_Export_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _self = rule742 _nameIself _namesIself _rangeIself + _lhsOself :: Export + _lhsOself = rule743 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule742 #-} + rule742 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Export_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule743 #-} + rule743 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClassComplete #-} +sem_Export_TypeOrClassComplete :: T_Range -> T_Name -> T_Export +sem_Export_TypeOrClassComplete arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule744 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule745 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule744 #-} + rule744 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule745 #-} + rule745 = \ _self -> + _self +{-# NOINLINE sem_Export_Module #-} +sem_Export_Module :: T_Range -> T_Name -> T_Export +sem_Export_Module arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule746 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule747 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule746 #-} + rule746 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Module _rangeIself _nameIself + {-# INLINE rule747 #-} + rule747 = \ _self -> + _self + +-- Exports ----------------------------------------------------- +-- wrapper +data Inh_Exports = Inh_Exports { } +data Syn_Exports = Syn_Exports { self_Syn_Exports :: (Exports) } +{-# INLINABLE wrap_Exports #-} +wrap_Exports :: T_Exports -> Inh_Exports -> (Syn_Exports ) +wrap_Exports (T_Exports act) (Inh_Exports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Exports_vIn37 + (T_Exports_vOut37 _lhsOself) <- return (inv_Exports_s38 sem arg) + return (Syn_Exports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Exports #-} +sem_Exports :: Exports -> T_Exports +sem_Exports list = Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list) + +-- semantic domain +newtype T_Exports = T_Exports { + attach_T_Exports :: Identity (T_Exports_s38 ) + } +newtype T_Exports_s38 = C_Exports_s38 { + inv_Exports_s38 :: (T_Exports_v37 ) + } +data T_Exports_s39 = C_Exports_s39 +type T_Exports_v37 = (T_Exports_vIn37 ) -> (T_Exports_vOut37 ) +data T_Exports_vIn37 = T_Exports_vIn37 +data T_Exports_vOut37 = T_Exports_vOut37 (Exports) +{-# NOINLINE sem_Exports_Cons #-} +sem_Exports_Cons :: T_Export -> T_Exports -> T_Exports +sem_Exports_Cons arg_hd_ arg_tl_ = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Export (arg_hd_)) + _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_tl_)) + (T_Export_vOut34 _hdIself) = inv_Export_s35 _hdX35 (T_Export_vIn34 ) + (T_Exports_vOut37 _tlIself) = inv_Exports_s38 _tlX38 (T_Exports_vIn37 ) + _self = rule748 _hdIself _tlIself + _lhsOself :: Exports + _lhsOself = rule749 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule748 #-} + rule748 = \ ((_hdIself) :: Export) ((_tlIself) :: Exports) -> + (:) _hdIself _tlIself + {-# INLINE rule749 #-} + rule749 = \ _self -> + _self +{-# NOINLINE sem_Exports_Nil #-} +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _self = rule750 () + _lhsOself :: Exports + _lhsOself = rule751 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule750 #-} + rule750 = \ (_ :: ()) -> + [] + {-# INLINE rule751 #-} + rule751 = \ _self -> + _self + +-- Expression -------------------------------------------------- +-- wrapper +data Inh_Expression = Inh_Expression { allPatterns_Inh_Expression :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_Expression :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_Expression :: (Predicates), betaUnique_Inh_Expression :: (Int), classEnvironment_Inh_Expression :: (ClassEnvironment), collectErrors_Inh_Expression :: (TypeErrors), collectWarnings_Inh_Expression :: (Warnings), counter_Inh_Expression :: (Int), currentChunk_Inh_Expression :: (Int), dictionaryEnvironment_Inh_Expression :: (DictionaryEnvironment), importEnvironment_Inh_Expression :: (ImportEnvironment), matchIO_Inh_Expression :: (IO ()), monos_Inh_Expression :: (Monos), namesInScope_Inh_Expression :: (Names), orderedTypeSynonyms_Inh_Expression :: (OrderedTypeSynonyms), parentTree_Inh_Expression :: (InfoTree), patternMatchWarnings_Inh_Expression :: ([Warning]), substitution_Inh_Expression :: (FixpointSubstitution), tryPatterns_Inh_Expression :: ([(Expression , [String])]), typeschemeMap_Inh_Expression :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_Expression :: (Int), uniqueSecondRound_Inh_Expression :: (Int) } +data Syn_Expression = Syn_Expression { assumptions_Syn_Expression :: (Assumptions), beta_Syn_Expression :: (Tp), betaUnique_Syn_Expression :: (Int), collectErrors_Syn_Expression :: (TypeErrors), collectInstances_Syn_Expression :: ([(Name, Instance)]), collectWarnings_Syn_Expression :: (Warnings), constraints_Syn_Expression :: (ConstraintSet), counter_Syn_Expression :: (Int), dictionaryEnvironment_Syn_Expression :: (DictionaryEnvironment), infoTree_Syn_Expression :: (InfoTree), matchIO_Syn_Expression :: (IO ()), matches_Syn_Expression :: ([Maybe MetaVariableTable]), patternMatchWarnings_Syn_Expression :: ([Warning]), self_Syn_Expression :: (Expression), unboundNames_Syn_Expression :: (Names), uniqueChunk_Syn_Expression :: (Int), uniqueSecondRound_Syn_Expression :: (Int) } +{-# INLINABLE wrap_Expression #-} +wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) +wrap_Expression (T_Expression act) (Inh_Expression _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound + (T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) <- return (inv_Expression_s41 sem arg) + return (Syn_Expression _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) + ) + +-- cata +{-# NOINLINE sem_Expression #-} +sem_Expression :: Expression -> T_Expression +sem_Expression ( Expression_Hole range_ id_ ) = sem_Expression_Hole ( sem_Range range_ ) id_ +sem_Expression ( Expression_Feedback range_ feedback_ expression_ ) = sem_Expression_Feedback ( sem_Range range_ ) feedback_ ( sem_Expression expression_ ) +sem_Expression ( Expression_MustUse range_ expression_ ) = sem_Expression_MustUse ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Literal range_ literal_ ) = sem_Expression_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Expression ( Expression_Variable range_ name_ ) = sem_Expression_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Constructor range_ name_ ) = sem_Expression_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Parenthesized range_ expression_ ) = sem_Expression_Parenthesized ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NormalApplication range_ function_ arguments_ ) = sem_Expression_NormalApplication ( sem_Range range_ ) ( sem_Expression function_ ) ( sem_Expressions arguments_ ) +sem_Expression ( Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ ) = sem_Expression_InfixApplication ( sem_Range range_ ) ( sem_MaybeExpression leftExpression_ ) ( sem_Expression operator_ ) ( sem_MaybeExpression rightExpression_ ) +sem_Expression ( Expression_If range_ guardExpression_ thenExpression_ elseExpression_ ) = sem_Expression_If ( sem_Range range_ ) ( sem_Expression guardExpression_ ) ( sem_Expression thenExpression_ ) ( sem_Expression elseExpression_ ) +sem_Expression ( Expression_Lambda range_ patterns_ expression_ ) = sem_Expression_Lambda ( sem_Range range_ ) ( sem_Patterns patterns_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Case range_ expression_ alternatives_ ) = sem_Expression_Case ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Alternatives alternatives_ ) +sem_Expression ( Expression_Let range_ declarations_ expression_ ) = sem_Expression_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Do range_ statements_ ) = sem_Expression_Do ( sem_Range range_ ) ( sem_Statements statements_ ) +sem_Expression ( Expression_List range_ expressions_ ) = sem_Expression_List ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Tuple range_ expressions_ ) = sem_Expression_Tuple ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Comprehension range_ expression_ qualifiers_ ) = sem_Expression_Comprehension ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Qualifiers qualifiers_ ) +sem_Expression ( Expression_Typed range_ expression_ type_ ) = sem_Expression_Typed ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Type type_ ) +sem_Expression ( Expression_RecordConstruction range_ name_ recordExpressionBindings_ ) = sem_Expression_RecordConstruction ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_RecordUpdate range_ expression_ recordExpressionBindings_ ) = sem_Expression_RecordUpdate ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_Enum range_ from_ then_ to_ ) = sem_Expression_Enum ( sem_Range range_ ) ( sem_Expression from_ ) ( sem_MaybeExpression then_ ) ( sem_MaybeExpression to_ ) +sem_Expression ( Expression_Negate range_ expression_ ) = sem_Expression_Negate ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NegateFloat range_ expression_ ) = sem_Expression_NegateFloat ( sem_Range range_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_Expression = T_Expression { + attach_T_Expression :: Identity (T_Expression_s41 ) + } +newtype T_Expression_s41 = C_Expression_s41 { + inv_Expression_s41 :: (T_Expression_v40 ) + } +data T_Expression_s42 = C_Expression_s42 +type T_Expression_v40 = (T_Expression_vIn40 ) -> (T_Expression_vOut40 ) +data T_Expression_vIn40 = T_Expression_vIn40 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) ([(Expression , [String])]) (M.Map Int (Scheme Predicates)) (Int) (Int) +data T_Expression_vOut40 = T_Expression_vOut40 (Assumptions) (Tp) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (DictionaryEnvironment) (InfoTree) (IO ()) ([Maybe MetaVariableTable]) ([Warning]) (Expression) (Names) (Int) (Int) +{-# NOINLINE sem_Expression_Hole #-} +sem_Expression_Hole :: T_Range -> (Integer) -> T_Expression +sem_Expression_Hole arg_range_ arg_id_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsObetaUnique :: Int + _lhsObetaUnique = rule752 _lhsIbetaUnique + _assumptions = rule753 () + _constraints = rule754 () + _beta = rule755 _lhsIbetaUnique + _localInfo = rule756 _beta _lhsImonos _self + _parentTree = rule757 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule758 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + ((),_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule759 _assumptions _constraints _lhsIallPatterns _lhsItryPatterns _lhsIuniqueSecondRound _localInfo + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule760 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule761 () + _self = rule762 _rangeIself arg_id_ + _lhsOself :: Expression + _lhsOself = rule763 _self + _lhsObeta :: Tp + _lhsObeta = rule764 _beta + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule765 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule766 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule767 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule768 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule769 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule770 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule771 _lhsIuniqueChunk + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule752 #-} + rule752 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule753 #-} + rule753 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule754 #-} + rule754 = \ (_ :: ()) -> + emptyTree + {-# INLINE rule755 #-} + rule755 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule756 #-} + rule756 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule757 #-} + rule757 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule758 #-} + rule758 = \ _parentTree -> + _parentTree + {-# INLINE rule759 #-} + rule759 = \ _assumptions _constraints ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) ((_lhsIuniqueSecondRound) :: Int) _localInfo -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in match0 infoTuple _lhsIuniqueSecondRound + (const Nothing) + _lhsItryPatterns _lhsIallPatterns + [] + {-# INLINE rule760 #-} + rule760 = \ (_ :: ()) -> + [] + {-# INLINE rule761 #-} + rule761 = \ (_ :: ()) -> + [] + {-# INLINE rule762 #-} + rule762 = \ ((_rangeIself) :: Range) id_ -> + Expression_Hole _rangeIself id_ + {-# INLINE rule763 #-} + rule763 = \ _self -> + _self + {-# INLINE rule764 #-} + rule764 = \ _beta -> + _beta + {-# INLINE rule765 #-} + rule765 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule766 #-} + rule766 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule767 #-} + rule767 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule768 #-} + rule768 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule769 #-} + rule769 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule770 #-} + rule770 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule771 #-} + rule771 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Expression_Feedback #-} +sem_Expression_Feedback :: T_Range -> (String) -> T_Expression -> T_Expression +sem_Expression_Feedback arg_range_ arg_feedback_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule772 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule773 _expressionIunboundNames + _self = rule774 _expressionIself _rangeIself arg_feedback_ + _lhsOself :: Expression + _lhsOself = rule775 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule776 _expressionIassumptions + _lhsObeta :: Tp + _lhsObeta = rule777 _expressionIbeta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule778 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule779 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule780 _expressionIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule781 _expressionIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule782 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule783 _expressionIdictionaryEnvironment + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule784 _expressionIinfoTree + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule785 _expressionImatchIO + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOmatches = rule786 _expressionImatches + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule787 _expressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule788 _expressionIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule789 _expressionIuniqueSecondRound + _expressionOallPatterns = rule790 _lhsIallPatterns + _expressionOallTypeSchemes = rule791 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule792 _lhsIavailablePredicates + _expressionObetaUnique = rule793 _lhsIbetaUnique + _expressionOclassEnvironment = rule794 _lhsIclassEnvironment + _expressionOcollectErrors = rule795 _lhsIcollectErrors + _expressionOcollectWarnings = rule796 _lhsIcollectWarnings + _expressionOcounter = rule797 _lhsIcounter + _expressionOcurrentChunk = rule798 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule799 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule800 _lhsIimportEnvironment + _expressionOmatchIO = rule801 _lhsImatchIO + _expressionOmonos = rule802 _lhsImonos + _expressionOnamesInScope = rule803 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule804 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule805 _lhsIparentTree + _expressionOpatternMatchWarnings = rule806 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule807 _lhsIsubstitution + _expressionOtryPatterns = rule808 _lhsItryPatterns + _expressionOtypeschemeMap = rule809 _lhsItypeschemeMap + _expressionOuniqueChunk = rule810 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule811 _lhsIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule772 #-} + rule772 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule773 #-} + rule773 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule774 #-} + rule774 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) feedback_ -> + Expression_Feedback _rangeIself feedback_ _expressionIself + {-# INLINE rule775 #-} + rule775 = \ _self -> + _self + {-# INLINE rule776 #-} + rule776 = \ ((_expressionIassumptions) :: Assumptions) -> + _expressionIassumptions + {-# INLINE rule777 #-} + rule777 = \ ((_expressionIbeta) :: Tp) -> + _expressionIbeta + {-# INLINE rule778 #-} + rule778 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule779 #-} + rule779 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule780 #-} + rule780 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule781 #-} + rule781 = \ ((_expressionIconstraints) :: ConstraintSet) -> + _expressionIconstraints + {-# INLINE rule782 #-} + rule782 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule783 #-} + rule783 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule784 #-} + rule784 = \ ((_expressionIinfoTree) :: InfoTree) -> + _expressionIinfoTree + {-# INLINE rule785 #-} + rule785 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule786 #-} + rule786 = \ ((_expressionImatches) :: [Maybe MetaVariableTable]) -> + _expressionImatches + {-# INLINE rule787 #-} + rule787 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule788 #-} + rule788 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule789 #-} + rule789 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule790 #-} + rule790 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule791 #-} + rule791 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule792 #-} + rule792 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule793 #-} + rule793 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule794 #-} + rule794 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule795 #-} + rule795 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule796 #-} + rule796 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule797 #-} + rule797 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule798 #-} + rule798 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule799 #-} + rule799 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule800 #-} + rule800 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule801 #-} + rule801 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule802 #-} + rule802 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule803 #-} + rule803 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule804 #-} + rule804 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule805 #-} + rule805 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule806 #-} + rule806 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule807 #-} + rule807 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule808 #-} + rule808 = \ ((_lhsItryPatterns) :: [(Expression , [String])]) -> + _lhsItryPatterns + {-# INLINE rule809 #-} + rule809 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule810 #-} + rule810 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule811 #-} + rule811 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Expression_MustUse #-} +sem_Expression_MustUse :: T_Range -> T_Expression -> T_Expression +sem_Expression_MustUse arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule812 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule813 _expressionIunboundNames + _self = rule814 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule815 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule816 _expressionIassumptions + _lhsObeta :: Tp + _lhsObeta = rule817 _expressionIbeta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule818 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule819 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule820 _expressionIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule821 _expressionIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule822 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule823 _expressionIdictionaryEnvironment + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule824 _expressionIinfoTree + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule825 _expressionImatchIO + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOmatches = rule826 _expressionImatches + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule827 _expressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule828 _expressionIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule829 _expressionIuniqueSecondRound + _expressionOallPatterns = rule830 _lhsIallPatterns + _expressionOallTypeSchemes = rule831 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule832 _lhsIavailablePredicates + _expressionObetaUnique = rule833 _lhsIbetaUnique + _expressionOclassEnvironment = rule834 _lhsIclassEnvironment + _expressionOcollectErrors = rule835 _lhsIcollectErrors + _expressionOcollectWarnings = rule836 _lhsIcollectWarnings + _expressionOcounter = rule837 _lhsIcounter + _expressionOcurrentChunk = rule838 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule839 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule840 _lhsIimportEnvironment + _expressionOmatchIO = rule841 _lhsImatchIO + _expressionOmonos = rule842 _lhsImonos + _expressionOnamesInScope = rule843 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule844 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule845 _lhsIparentTree + _expressionOpatternMatchWarnings = rule846 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule847 _lhsIsubstitution + _expressionOtryPatterns = rule848 _lhsItryPatterns + _expressionOtypeschemeMap = rule849 _lhsItypeschemeMap + _expressionOuniqueChunk = rule850 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule851 _lhsIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule812 #-} + rule812 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule813 #-} + rule813 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule814 #-} + rule814 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_MustUse _rangeIself _expressionIself + {-# INLINE rule815 #-} + rule815 = \ _self -> + _self + {-# INLINE rule816 #-} + rule816 = \ ((_expressionIassumptions) :: Assumptions) -> + _expressionIassumptions + {-# INLINE rule817 #-} + rule817 = \ ((_expressionIbeta) :: Tp) -> + _expressionIbeta + {-# INLINE rule818 #-} + rule818 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule819 #-} + rule819 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule820 #-} + rule820 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule821 #-} + rule821 = \ ((_expressionIconstraints) :: ConstraintSet) -> + _expressionIconstraints + {-# INLINE rule822 #-} + rule822 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule823 #-} + rule823 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule824 #-} + rule824 = \ ((_expressionIinfoTree) :: InfoTree) -> + _expressionIinfoTree + {-# INLINE rule825 #-} + rule825 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule826 #-} + rule826 = \ ((_expressionImatches) :: [Maybe MetaVariableTable]) -> + _expressionImatches + {-# INLINE rule827 #-} + rule827 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule828 #-} + rule828 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule829 #-} + rule829 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule830 #-} + rule830 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule831 #-} + rule831 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule832 #-} + rule832 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule833 #-} + rule833 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule834 #-} + rule834 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule835 #-} + rule835 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule836 #-} + rule836 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule837 #-} + rule837 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule838 #-} + rule838 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule839 #-} + rule839 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule840 #-} + rule840 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule841 #-} + rule841 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule842 #-} + rule842 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule843 #-} + rule843 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule844 #-} + rule844 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule845 #-} + rule845 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule846 #-} + rule846 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule847 #-} + rule847 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule848 #-} + rule848 = \ ((_lhsItryPatterns) :: [(Expression , [String])]) -> + _lhsItryPatterns + {-# INLINE rule849 #-} + rule849 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule850 #-} + rule850 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule851 #-} + rule851 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Expression_Literal #-} +sem_Expression_Literal :: T_Range -> T_Literal -> T_Expression +sem_Expression_Literal arg_range_ arg_literal_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIelements _literalIliteralType _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _lhsObetaUnique :: Int + _lhsObetaUnique = rule852 _lhsIbetaUnique + _assumptions = rule853 () + _constraints = rule854 _beta _cinfo _literalIliteralType + _beta = rule855 _lhsIbetaUnique + _cinfo = rule856 _parentTree + _localInfo = rule857 _beta _lhsImonos _self + _parentTree = rule858 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule859 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + ((),_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule860 _assumptions _constraints _lhsIallPatterns _lhsItryPatterns _lhsIuniqueSecondRound _literalIself _localInfo + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule861 _ioMatch _lhsImatchIO + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule862 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule863 () + _self = rule864 _literalIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule865 _self + _lhsObeta :: Tp + _lhsObeta = rule866 _beta + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule867 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule868 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule869 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule870 _lhsIdictionaryEnvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule871 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule872 _lhsIuniqueChunk + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule852 #-} + rule852 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule853 #-} + rule853 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule854 #-} + rule854 = \ _beta _cinfo ((_literalIliteralType) :: Tp) -> + unitTree ((_literalIliteralType .==. _beta) _cinfo) + {-# INLINE rule855 #-} + rule855 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule856 #-} + rule856 = \ _parentTree -> + resultConstraint "literal" _parentTree + [ FolkloreConstraint, HasTrustFactor 10.0 ] + {-# INLINE rule857 #-} + rule857 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule858 #-} + rule858 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule859 #-} + rule859 = \ _parentTree -> + _parentTree + {-# INLINE rule860 #-} + rule860 = \ _assumptions _constraints ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) ((_lhsIuniqueSecondRound) :: Int) ((_literalIself) :: Literal) _localInfo -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in match0 infoTuple _lhsIuniqueSecondRound + (match_Expression_Literal _literalIself) + _lhsItryPatterns _lhsIallPatterns + [] + {-# INLINE rule861 #-} + rule861 = \ _ioMatch ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO >> _ioMatch + {-# INLINE rule862 #-} + rule862 = \ (_ :: ()) -> + [] + {-# INLINE rule863 #-} + rule863 = \ (_ :: ()) -> + [] + {-# INLINE rule864 #-} + rule864 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Expression_Literal _rangeIself _literalIself + {-# INLINE rule865 #-} + rule865 = \ _self -> + _self + {-# INLINE rule866 #-} + rule866 = \ _beta -> + _beta + {-# INLINE rule867 #-} + rule867 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule868 #-} + rule868 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule869 #-} + rule869 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule870 #-} + rule870 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule871 #-} + rule871 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule872 #-} + rule872 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Expression_Variable #-} +sem_Expression_Variable :: T_Range -> T_Name -> T_Expression +sem_Expression_Variable arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsObetaUnique :: Int + _lhsObetaUnique = rule873 _lhsIbetaUnique + _assumptions = rule874 _beta _nameIself + _constraints = rule875 _lhsIbetaUnique + _beta = rule876 _lhsIbetaUnique + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule877 _newDEnv + _nameInScope = rule878 _lhsInamesInScope _nameIself + _maybeInferredType = rule879 _lhsIallTypeSchemes _nameInScope + _requiredDictionaries = rule880 _lhsIimportEnvironment _lhsIsubstitution _maybeInferredType _usedAsType + _newDEnv = rule881 _lhsIavailablePredicates _lhsIclassEnvironment _lhsIdictionaryEnvironment _lhsIsubstitution _nameIself _requiredDictionaries + _usedAsType = rule882 _beta _lhsIsubstitution + _localInfo = rule883 _beta _lhsImonos _self + _parentTree = rule884 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule885 _parentTree + _lhsOunboundNames :: Names + _lhsOunboundNames = rule886 _nameIself + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + ((),_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule887 _assumptions _constraints _lhsIallPatterns _lhsItryPatterns _lhsIuniqueSecondRound _localInfo _nameIself + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule888 _ioMatch _lhsImatchIO + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule889 () + _self = rule890 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule891 _self + _lhsObeta :: Tp + _lhsObeta = rule892 _beta + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule893 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule894 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule895 _lhsIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule896 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule897 _lhsIuniqueChunk + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule873 #-} + rule873 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule874 #-} + rule874 = \ _beta ((_nameIself) :: Name) -> + _nameIself `single` _beta + {-# INLINE rule875 #-} + rule875 = \ ((_lhsIbetaUnique) :: Int) -> + Node [ Receive _lhsIbetaUnique ] + {-# INLINE rule876 #-} + rule876 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule877 #-} + rule877 = \ _newDEnv -> + _newDEnv + {-# INLINE rule878 #-} + rule878 = \ ((_lhsInamesInScope) :: Names) ((_nameIself) :: Name) -> + case filter (_nameIself==) _lhsInamesInScope of + [name] -> NameWithRange name + _ -> internalError "TypeInferenceOverloading.ag" "n/a" "name not in scope" + {-# INLINE rule879 #-} + rule879 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) _nameInScope -> + M.lookup _nameInScope _lhsIallTypeSchemes + {-# INLINE rule880 #-} + rule880 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) ((_lhsIsubstitution) :: FixpointSubstitution) _maybeInferredType _usedAsType -> + case _maybeInferredType of + Nothing -> [] + Just scheme -> getRequiredDictionaries + (getOrderedTypeSynonyms _lhsIimportEnvironment) + (_lhsIsubstitution |-> _usedAsType) + (_lhsIsubstitution |-> scheme) + {-# INLINE rule881 #-} + rule881 = \ ((_lhsIavailablePredicates) :: Predicates) ((_lhsIclassEnvironment) :: ClassEnvironment) ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) ((_lhsIsubstitution) :: FixpointSubstitution) ((_nameIself) :: Name) _requiredDictionaries -> + resolveOverloading (_lhsIclassEnvironment) + _nameIself + (_lhsIsubstitution |-> _lhsIavailablePredicates) + (_lhsIsubstitution |-> _requiredDictionaries) + _lhsIdictionaryEnvironment + {-# INLINE rule882 #-} + rule882 = \ _beta ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution |-> _beta + {-# INLINE rule883 #-} + rule883 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule884 #-} + rule884 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule885 #-} + rule885 = \ _parentTree -> + _parentTree + {-# INLINE rule886 #-} + rule886 = \ ((_nameIself) :: Name) -> + [ _nameIself ] + {-# INLINE rule887 #-} + rule887 = \ _assumptions _constraints ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) ((_lhsIuniqueSecondRound) :: Int) _localInfo ((_nameIself) :: Name) -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in match0 infoTuple _lhsIuniqueSecondRound + (match_Expression_Variable _nameIself) + _lhsItryPatterns _lhsIallPatterns + [] + {-# INLINE rule888 #-} + rule888 = \ _ioMatch ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO >> _ioMatch + {-# INLINE rule889 #-} + rule889 = \ (_ :: ()) -> + [] + {-# INLINE rule890 #-} + rule890 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Variable _rangeIself _nameIself + {-# INLINE rule891 #-} + rule891 = \ _self -> + _self + {-# INLINE rule892 #-} + rule892 = \ _beta -> + _beta + {-# INLINE rule893 #-} + rule893 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule894 #-} + rule894 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule895 #-} + rule895 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule896 #-} + rule896 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule897 #-} + rule897 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Expression_Constructor #-} +sem_Expression_Constructor :: T_Range -> T_Name -> T_Expression +sem_Expression_Constructor arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsObetaUnique :: Int + _lhsObetaUnique = rule898 _lhsIbetaUnique + _assumptions = rule899 () + _constraints = rule900 _newcon + _beta = rule901 _lhsIbetaUnique + _newcon = rule902 _beta _cinfo _lhsIimportEnvironment _nameIself + _cinfo = rule903 _nameIself _parentTree + _localInfo = rule904 _beta _lhsImonos _self + _parentTree = rule905 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule906 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + ((),_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule907 _assumptions _constraints _lhsIallPatterns _lhsItryPatterns _lhsIuniqueSecondRound _localInfo _nameIself + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule908 _ioMatch _lhsImatchIO + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule909 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule910 () + _self = rule911 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule912 _self + _lhsObeta :: Tp + _lhsObeta = rule913 _beta + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule914 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule915 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule916 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule917 _lhsIdictionaryEnvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule918 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule919 _lhsIuniqueChunk + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule898 #-} + rule898 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule899 #-} + rule899 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule900 #-} + rule900 = \ _newcon -> + listTree _newcon + {-# INLINE rule901 #-} + rule901 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule902 #-} + rule902 = \ _beta _cinfo ((_lhsIimportEnvironment) :: ImportEnvironment) ((_nameIself) :: Name) -> + case M.lookup _nameIself (valueConstructors _lhsIimportEnvironment) of + Nothing -> [] + Just ctp -> [ (_beta .::. ctp) _cinfo ] + {-# INLINE rule903 #-} + rule903 = \ ((_nameIself) :: Name) _parentTree -> + resultConstraint "constructor" _parentTree + [ FolkloreConstraint, HasTrustFactor 10.0, IsImported _nameIself ] + {-# INLINE rule904 #-} + rule904 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule905 #-} + rule905 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule906 #-} + rule906 = \ _parentTree -> + _parentTree + {-# INLINE rule907 #-} + rule907 = \ _assumptions _constraints ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) ((_lhsIuniqueSecondRound) :: Int) _localInfo ((_nameIself) :: Name) -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in match0 infoTuple _lhsIuniqueSecondRound + (match_Expression_Constructor _nameIself) + _lhsItryPatterns _lhsIallPatterns + [] + {-# INLINE rule908 #-} + rule908 = \ _ioMatch ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO >> _ioMatch + {-# INLINE rule909 #-} + rule909 = \ (_ :: ()) -> + [] + {-# INLINE rule910 #-} + rule910 = \ (_ :: ()) -> + [] + {-# INLINE rule911 #-} + rule911 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Constructor _rangeIself _nameIself + {-# INLINE rule912 #-} + rule912 = \ _self -> + _self + {-# INLINE rule913 #-} + rule913 = \ _beta -> + _beta + {-# INLINE rule914 #-} + rule914 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule915 #-} + rule915 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule916 #-} + rule916 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule917 #-} + rule917 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule918 #-} + rule918 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule919 #-} + rule919 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Expression_Parenthesized #-} +sem_Expression_Parenthesized :: T_Range -> T_Expression -> T_Expression +sem_Expression_Parenthesized arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule920 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule921 _expressionIunboundNames + _self = rule922 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule923 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule924 _expressionIassumptions + _lhsObeta :: Tp + _lhsObeta = rule925 _expressionIbeta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule926 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule927 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule928 _expressionIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule929 _expressionIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule930 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule931 _expressionIdictionaryEnvironment + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule932 _expressionIinfoTree + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule933 _expressionImatchIO + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOmatches = rule934 _expressionImatches + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule935 _expressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule936 _expressionIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule937 _expressionIuniqueSecondRound + _expressionOallPatterns = rule938 _lhsIallPatterns + _expressionOallTypeSchemes = rule939 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule940 _lhsIavailablePredicates + _expressionObetaUnique = rule941 _lhsIbetaUnique + _expressionOclassEnvironment = rule942 _lhsIclassEnvironment + _expressionOcollectErrors = rule943 _lhsIcollectErrors + _expressionOcollectWarnings = rule944 _lhsIcollectWarnings + _expressionOcounter = rule945 _lhsIcounter + _expressionOcurrentChunk = rule946 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule947 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule948 _lhsIimportEnvironment + _expressionOmatchIO = rule949 _lhsImatchIO + _expressionOmonos = rule950 _lhsImonos + _expressionOnamesInScope = rule951 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule952 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule953 _lhsIparentTree + _expressionOpatternMatchWarnings = rule954 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule955 _lhsIsubstitution + _expressionOtryPatterns = rule956 _lhsItryPatterns + _expressionOtypeschemeMap = rule957 _lhsItypeschemeMap + _expressionOuniqueChunk = rule958 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule959 _lhsIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule920 #-} + rule920 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule921 #-} + rule921 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule922 #-} + rule922 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Parenthesized _rangeIself _expressionIself + {-# INLINE rule923 #-} + rule923 = \ _self -> + _self + {-# INLINE rule924 #-} + rule924 = \ ((_expressionIassumptions) :: Assumptions) -> + _expressionIassumptions + {-# INLINE rule925 #-} + rule925 = \ ((_expressionIbeta) :: Tp) -> + _expressionIbeta + {-# INLINE rule926 #-} + rule926 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule927 #-} + rule927 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule928 #-} + rule928 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule929 #-} + rule929 = \ ((_expressionIconstraints) :: ConstraintSet) -> + _expressionIconstraints + {-# INLINE rule930 #-} + rule930 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule931 #-} + rule931 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule932 #-} + rule932 = \ ((_expressionIinfoTree) :: InfoTree) -> + _expressionIinfoTree + {-# INLINE rule933 #-} + rule933 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule934 #-} + rule934 = \ ((_expressionImatches) :: [Maybe MetaVariableTable]) -> + _expressionImatches + {-# INLINE rule935 #-} + rule935 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule936 #-} + rule936 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule937 #-} + rule937 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule938 #-} + rule938 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule939 #-} + rule939 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule940 #-} + rule940 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule941 #-} + rule941 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule942 #-} + rule942 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule943 #-} + rule943 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule944 #-} + rule944 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule945 #-} + rule945 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule946 #-} + rule946 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule947 #-} + rule947 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule948 #-} + rule948 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule949 #-} + rule949 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule950 #-} + rule950 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule951 #-} + rule951 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule952 #-} + rule952 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule953 #-} + rule953 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule954 #-} + rule954 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule955 #-} + rule955 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule956 #-} + rule956 = \ ((_lhsItryPatterns) :: [(Expression , [String])]) -> + _lhsItryPatterns + {-# INLINE rule957 #-} + rule957 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule958 #-} + rule958 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule959 #-} + rule959 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Expression_NormalApplication #-} +sem_Expression_NormalApplication :: T_Range -> T_Expression -> T_Expressions -> T_Expression +sem_Expression_NormalApplication arg_range_ arg_function_ arg_arguments_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_function_)) + _argumentsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _functionIassumptions _functionIbeta _functionIbetaUnique _functionIcollectErrors _functionIcollectInstances _functionIcollectWarnings _functionIconstraints _functionIcounter _functionIdictionaryEnvironment _functionIinfoTree _functionImatchIO _functionImatches _functionIpatternMatchWarnings _functionIself _functionIunboundNames _functionIuniqueChunk _functionIuniqueSecondRound) = inv_Expression_s41 _functionX41 (T_Expression_vIn40 _functionOallPatterns _functionOallTypeSchemes _functionOavailablePredicates _functionObetaUnique _functionOclassEnvironment _functionOcollectErrors _functionOcollectWarnings _functionOcounter _functionOcurrentChunk _functionOdictionaryEnvironment _functionOimportEnvironment _functionOmatchIO _functionOmonos _functionOnamesInScope _functionOorderedTypeSynonyms _functionOparentTree _functionOpatternMatchWarnings _functionOsubstitution _functionOtryPatterns _functionOtypeschemeMap _functionOuniqueChunk _functionOuniqueSecondRound) + (T_Expressions_vOut43 _argumentsIassumptions _argumentsIbetaUnique _argumentsIbetas _argumentsIcollectErrors _argumentsIcollectInstances _argumentsIcollectWarnings _argumentsIconstraintslist _argumentsIcounter _argumentsIdictionaryEnvironment _argumentsIinfoTrees _argumentsImatchIO _argumentsImatches _argumentsIpatternMatchWarnings _argumentsIself _argumentsIunboundNames _argumentsIuniqueChunk _argumentsIuniqueSecondRound) = inv_Expressions_s44 _argumentsX44 (T_Expressions_vIn43 _argumentsOallPatterns _argumentsOallTypeSchemes _argumentsOavailablePredicates _argumentsObetaUnique _argumentsOclassEnvironment _argumentsOcollectErrors _argumentsOcollectWarnings _argumentsOcounter _argumentsOcurrentChunk _argumentsOdictionaryEnvironment _argumentsOimportEnvironment _argumentsOmatchIO _argumentsOmonos _argumentsOnamesInScope _argumentsOorderedTypeSynonyms _argumentsOparentTree _argumentsOpatternMatchWarnings _argumentsOsubstitution _argumentsOtryPatterns _argumentsOtypeschemeMap _argumentsOuniqueChunk _argumentsOuniqueSecondRound) + _functionObetaUnique = rule960 _lhsIbetaUnique + _assumptions = rule961 _argumentsIassumptions _functionIassumptions + _constraints = rule962 _argumentsIconstraintslist _functionIconstraints _newcon + _beta = rule963 _lhsIbetaUnique + _newcon = rule964 _argumentsIbetas _beta _cinfo _functionIbeta + _cinfo = rule965 _argumentsIinfoTrees _parentTree + _localInfo = rule966 _beta _lhsImonos _self + _parentTree = rule967 _argumentsIinfoTrees _functionIinfoTree _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule968 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + ((_functionOtryPatterns,_argumentsOtryPatterns),_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule969 _argumentsImatches _argumentsIuniqueSecondRound _assumptions _constraints _functionImatches _lhsIallPatterns _lhsItryPatterns _localInfo + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule970 _argumentsImatchIO _ioMatch + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule971 _argumentsIcollectInstances _functionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule972 _argumentsIunboundNames _functionIunboundNames + _self = rule973 _argumentsIself _functionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule974 _self + _lhsObeta :: Tp + _lhsObeta = rule975 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule976 _argumentsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule977 _argumentsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule978 _argumentsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule979 _argumentsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule980 _argumentsIdictionaryEnvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule981 _argumentsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule982 _argumentsIuniqueChunk + _functionOallPatterns = rule983 _lhsIallPatterns + _functionOallTypeSchemes = rule984 _lhsIallTypeSchemes + _functionOavailablePredicates = rule985 _lhsIavailablePredicates + _functionOclassEnvironment = rule986 _lhsIclassEnvironment + _functionOcollectErrors = rule987 _lhsIcollectErrors + _functionOcollectWarnings = rule988 _lhsIcollectWarnings + _functionOcounter = rule989 _lhsIcounter + _functionOcurrentChunk = rule990 _lhsIcurrentChunk + _functionOdictionaryEnvironment = rule991 _lhsIdictionaryEnvironment + _functionOimportEnvironment = rule992 _lhsIimportEnvironment + _functionOmatchIO = rule993 _lhsImatchIO + _functionOmonos = rule994 _lhsImonos + _functionOnamesInScope = rule995 _lhsInamesInScope + _functionOorderedTypeSynonyms = rule996 _lhsIorderedTypeSynonyms + _functionOparentTree = rule997 _parentTree + _functionOpatternMatchWarnings = rule998 _lhsIpatternMatchWarnings + _functionOsubstitution = rule999 _lhsIsubstitution + _functionOtypeschemeMap = rule1000 _lhsItypeschemeMap + _functionOuniqueChunk = rule1001 _lhsIuniqueChunk + _functionOuniqueSecondRound = rule1002 _lhsIuniqueSecondRound + _argumentsOallPatterns = rule1003 _lhsIallPatterns + _argumentsOallTypeSchemes = rule1004 _lhsIallTypeSchemes + _argumentsOavailablePredicates = rule1005 _lhsIavailablePredicates + _argumentsObetaUnique = rule1006 _functionIbetaUnique + _argumentsOclassEnvironment = rule1007 _lhsIclassEnvironment + _argumentsOcollectErrors = rule1008 _functionIcollectErrors + _argumentsOcollectWarnings = rule1009 _functionIcollectWarnings + _argumentsOcounter = rule1010 _functionIcounter + _argumentsOcurrentChunk = rule1011 _lhsIcurrentChunk + _argumentsOdictionaryEnvironment = rule1012 _functionIdictionaryEnvironment + _argumentsOimportEnvironment = rule1013 _lhsIimportEnvironment + _argumentsOmatchIO = rule1014 _functionImatchIO + _argumentsOmonos = rule1015 _lhsImonos + _argumentsOnamesInScope = rule1016 _lhsInamesInScope + _argumentsOorderedTypeSynonyms = rule1017 _lhsIorderedTypeSynonyms + _argumentsOparentTree = rule1018 _parentTree + _argumentsOpatternMatchWarnings = rule1019 _functionIpatternMatchWarnings + _argumentsOsubstitution = rule1020 _lhsIsubstitution + _argumentsOtypeschemeMap = rule1021 _lhsItypeschemeMap + _argumentsOuniqueChunk = rule1022 _functionIuniqueChunk + _argumentsOuniqueSecondRound = rule1023 _functionIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule960 #-} + rule960 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule961 #-} + rule961 = \ ((_argumentsIassumptions) :: Assumptions) ((_functionIassumptions) :: Assumptions) -> + _functionIassumptions `combine` _argumentsIassumptions + {-# INLINE rule962 #-} + rule962 = \ ((_argumentsIconstraintslist) :: ConstraintSets) ((_functionIconstraints) :: ConstraintSet) _newcon -> + _newcon .>. + Node [ _functionIconstraints + , Node _argumentsIconstraintslist + ] + {-# INLINE rule963 #-} + rule963 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule964 #-} + rule964 = \ ((_argumentsIbetas) :: Tps) _beta _cinfo ((_functionIbeta) :: Tp) -> + [ (_functionIbeta .==. foldr (.->.) _beta _argumentsIbetas) _cinfo ] + {-# INLINE rule965 #-} + rule965 = \ ((_argumentsIinfoTrees) :: InfoTrees) _parentTree -> + childConstraint 0 "application" _parentTree + [ ApplicationEdge False (map attribute _argumentsIinfoTrees) ] + {-# INLINE rule966 #-} + rule966 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule967 #-} + rule967 = \ ((_argumentsIinfoTrees) :: InfoTrees) ((_functionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo (_functionIinfoTree : _argumentsIinfoTrees) + {-# INLINE rule968 #-} + rule968 = \ _parentTree -> + _parentTree + {-# INLINE rule969 #-} + rule969 = \ ((_argumentsImatches) :: [Maybe MetaVariableTable]) ((_argumentsIuniqueSecondRound) :: Int) _assumptions _constraints ((_functionImatches) :: [Maybe MetaVariableTable]) ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in match2 infoTuple _argumentsIuniqueSecondRound + match_Expression_NormalApplication + _lhsItryPatterns _lhsIallPatterns + [_functionImatches, _argumentsImatches] + {-# INLINE rule970 #-} + rule970 = \ ((_argumentsImatchIO) :: IO ()) _ioMatch -> + _argumentsImatchIO >> _ioMatch + {-# INLINE rule971 #-} + rule971 = \ ((_argumentsIcollectInstances) :: [(Name, Instance)]) ((_functionIcollectInstances) :: [(Name, Instance)]) -> + _functionIcollectInstances ++ _argumentsIcollectInstances + {-# INLINE rule972 #-} + rule972 = \ ((_argumentsIunboundNames) :: Names) ((_functionIunboundNames) :: Names) -> + _functionIunboundNames ++ _argumentsIunboundNames + {-# INLINE rule973 #-} + rule973 = \ ((_argumentsIself) :: Expressions) ((_functionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NormalApplication _rangeIself _functionIself _argumentsIself + {-# INLINE rule974 #-} + rule974 = \ _self -> + _self + {-# INLINE rule975 #-} + rule975 = \ _beta -> + _beta + {-# INLINE rule976 #-} + rule976 = \ ((_argumentsIbetaUnique) :: Int) -> + _argumentsIbetaUnique + {-# INLINE rule977 #-} + rule977 = \ ((_argumentsIcollectErrors) :: TypeErrors) -> + _argumentsIcollectErrors + {-# INLINE rule978 #-} + rule978 = \ ((_argumentsIcollectWarnings) :: Warnings) -> + _argumentsIcollectWarnings + {-# INLINE rule979 #-} + rule979 = \ ((_argumentsIcounter) :: Int) -> + _argumentsIcounter + {-# INLINE rule980 #-} + rule980 = \ ((_argumentsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _argumentsIdictionaryEnvironment + {-# INLINE rule981 #-} + rule981 = \ ((_argumentsIpatternMatchWarnings) :: [Warning]) -> + _argumentsIpatternMatchWarnings + {-# INLINE rule982 #-} + rule982 = \ ((_argumentsIuniqueChunk) :: Int) -> + _argumentsIuniqueChunk + {-# INLINE rule983 #-} + rule983 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule984 #-} + rule984 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule985 #-} + rule985 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule986 #-} + rule986 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule987 #-} + rule987 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule988 #-} + rule988 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule989 #-} + rule989 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule990 #-} + rule990 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule991 #-} + rule991 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule992 #-} + rule992 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule993 #-} + rule993 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule994 #-} + rule994 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule995 #-} + rule995 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule996 #-} + rule996 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule997 #-} + rule997 = \ _parentTree -> + _parentTree + {-# INLINE rule998 #-} + rule998 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule999 #-} + rule999 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1000 #-} + rule1000 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1001 #-} + rule1001 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1002 #-} + rule1002 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule1003 #-} + rule1003 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1004 #-} + rule1004 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1005 #-} + rule1005 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1006 #-} + rule1006 = \ ((_functionIbetaUnique) :: Int) -> + _functionIbetaUnique + {-# INLINE rule1007 #-} + rule1007 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1008 #-} + rule1008 = \ ((_functionIcollectErrors) :: TypeErrors) -> + _functionIcollectErrors + {-# INLINE rule1009 #-} + rule1009 = \ ((_functionIcollectWarnings) :: Warnings) -> + _functionIcollectWarnings + {-# INLINE rule1010 #-} + rule1010 = \ ((_functionIcounter) :: Int) -> + _functionIcounter + {-# INLINE rule1011 #-} + rule1011 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1012 #-} + rule1012 = \ ((_functionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _functionIdictionaryEnvironment + {-# INLINE rule1013 #-} + rule1013 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1014 #-} + rule1014 = \ ((_functionImatchIO) :: IO ()) -> + _functionImatchIO + {-# INLINE rule1015 #-} + rule1015 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1016 #-} + rule1016 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1017 #-} + rule1017 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1018 #-} + rule1018 = \ _parentTree -> + _parentTree + {-# INLINE rule1019 #-} + rule1019 = \ ((_functionIpatternMatchWarnings) :: [Warning]) -> + _functionIpatternMatchWarnings + {-# INLINE rule1020 #-} + rule1020 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1021 #-} + rule1021 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1022 #-} + rule1022 = \ ((_functionIuniqueChunk) :: Int) -> + _functionIuniqueChunk + {-# INLINE rule1023 #-} + rule1023 = \ ((_functionIuniqueSecondRound) :: Int) -> + _functionIuniqueSecondRound +{-# NOINLINE sem_Expression_InfixApplication #-} +sem_Expression_InfixApplication :: T_Range -> T_MaybeExpression -> T_Expression -> T_MaybeExpression -> T_Expression +sem_Expression_InfixApplication arg_range_ arg_leftExpression_ arg_operator_ arg_rightExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_leftExpression_)) + _operatorX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_operator_)) + _rightExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_rightExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeExpression_vOut94 _leftExpressionIassumptions _leftExpressionIbeta _leftExpressionIbetaUnique _leftExpressionIcollectErrors _leftExpressionIcollectInstances _leftExpressionIcollectWarnings _leftExpressionIconstraints _leftExpressionIcounter _leftExpressionIdictionaryEnvironment _leftExpressionIinfoTrees _leftExpressionImatchIO _leftExpressionImatches _leftExpressionIpatternMatchWarnings _leftExpressionIsection _leftExpressionIself _leftExpressionIunboundNames _leftExpressionIuniqueChunk _leftExpressionIuniqueSecondRound) = inv_MaybeExpression_s95 _leftExpressionX95 (T_MaybeExpression_vIn94 _leftExpressionOallPatterns _leftExpressionOallTypeSchemes _leftExpressionOavailablePredicates _leftExpressionObetaUnique _leftExpressionOclassEnvironment _leftExpressionOcollectErrors _leftExpressionOcollectWarnings _leftExpressionOcounter _leftExpressionOcurrentChunk _leftExpressionOdictionaryEnvironment _leftExpressionOimportEnvironment _leftExpressionOmatchIO _leftExpressionOmonos _leftExpressionOnamesInScope _leftExpressionOorderedTypeSynonyms _leftExpressionOparentTree _leftExpressionOpatternMatchWarnings _leftExpressionOsubstitution _leftExpressionOtryPatterns _leftExpressionOtypeschemeMap _leftExpressionOuniqueChunk _leftExpressionOuniqueSecondRound) + (T_Expression_vOut40 _operatorIassumptions _operatorIbeta _operatorIbetaUnique _operatorIcollectErrors _operatorIcollectInstances _operatorIcollectWarnings _operatorIconstraints _operatorIcounter _operatorIdictionaryEnvironment _operatorIinfoTree _operatorImatchIO _operatorImatches _operatorIpatternMatchWarnings _operatorIself _operatorIunboundNames _operatorIuniqueChunk _operatorIuniqueSecondRound) = inv_Expression_s41 _operatorX41 (T_Expression_vIn40 _operatorOallPatterns _operatorOallTypeSchemes _operatorOavailablePredicates _operatorObetaUnique _operatorOclassEnvironment _operatorOcollectErrors _operatorOcollectWarnings _operatorOcounter _operatorOcurrentChunk _operatorOdictionaryEnvironment _operatorOimportEnvironment _operatorOmatchIO _operatorOmonos _operatorOnamesInScope _operatorOorderedTypeSynonyms _operatorOparentTree _operatorOpatternMatchWarnings _operatorOsubstitution _operatorOtryPatterns _operatorOtypeschemeMap _operatorOuniqueChunk _operatorOuniqueSecondRound) + (T_MaybeExpression_vOut94 _rightExpressionIassumptions _rightExpressionIbeta _rightExpressionIbetaUnique _rightExpressionIcollectErrors _rightExpressionIcollectInstances _rightExpressionIcollectWarnings _rightExpressionIconstraints _rightExpressionIcounter _rightExpressionIdictionaryEnvironment _rightExpressionIinfoTrees _rightExpressionImatchIO _rightExpressionImatches _rightExpressionIpatternMatchWarnings _rightExpressionIsection _rightExpressionIself _rightExpressionIunboundNames _rightExpressionIuniqueChunk _rightExpressionIuniqueSecondRound) = inv_MaybeExpression_s95 _rightExpressionX95 (T_MaybeExpression_vIn94 _rightExpressionOallPatterns _rightExpressionOallTypeSchemes _rightExpressionOavailablePredicates _rightExpressionObetaUnique _rightExpressionOclassEnvironment _rightExpressionOcollectErrors _rightExpressionOcollectWarnings _rightExpressionOcounter _rightExpressionOcurrentChunk _rightExpressionOdictionaryEnvironment _rightExpressionOimportEnvironment _rightExpressionOmatchIO _rightExpressionOmonos _rightExpressionOnamesInScope _rightExpressionOorderedTypeSynonyms _rightExpressionOparentTree _rightExpressionOpatternMatchWarnings _rightExpressionOsubstitution _rightExpressionOtryPatterns _rightExpressionOtypeschemeMap _rightExpressionOuniqueChunk _rightExpressionOuniqueSecondRound) + _leftExpressionObetaUnique = rule1024 _lhsIbetaUnique + _assumptions = rule1025 _leftExpressionIassumptions _operatorIassumptions _rightExpressionIassumptions + _constraints = rule1026 _conTotal _leftExpressionIconstraints _operatorIconstraints _rightExpressionIconstraints + _beta = rule1027 _lhsIbetaUnique + _betaResOp = rule1028 _lhsIbetaUnique + _conOperator = rule1029 _betaResOp _cinfoOperator _leftExpressionIbeta _operatorIbeta _rightExpressionIbeta + _conTotal = rule1030 _beta _betaResOp _cinfoComplete _cinfoEmpty _cinfoLeftSection _cinfoRightSection _conOperator _leftExpressionIbeta _leftExpressionIsection _operatorIbeta _rightExpressionIbeta _rightExpressionIsection + _operatorNr = rule1031 _leftExpressionIinfoTrees + _cinfoOperator = rule1032 _leftExpressionIinfoTrees _leftExpressionIsection _operatorNr _parentTree _rightExpressionIinfoTrees _rightExpressionIsection + _cinfoComplete = rule1033 _localInfo _parentTree + _cinfoLeftSection = rule1034 _localInfo _parentTree + _cinfoRightSection = rule1035 _localInfo _parentTree + _cinfoEmpty = rule1036 _localInfo _parentTree + _localInfo = rule1037 _beta _lhsImonos _self + _parentTree = rule1038 _leftExpressionIinfoTrees _lhsIparentTree _localInfo _operatorIinfoTree _rightExpressionIinfoTrees + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1039 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + ((_leftExpressionOtryPatterns,_operatorOtryPatterns,_rightExpressionOtryPatterns),_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule1040 _assumptions _constraints _leftExpressionImatches _lhsIallPatterns _lhsItryPatterns _localInfo _operatorImatches _rightExpressionImatches _rightExpressionIuniqueSecondRound + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1041 _ioMatch _rightExpressionImatchIO + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1042 _leftExpressionIcollectInstances _operatorIcollectInstances _rightExpressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1043 _leftExpressionIunboundNames _operatorIunboundNames _rightExpressionIunboundNames + _self = rule1044 _leftExpressionIself _operatorIself _rangeIself _rightExpressionIself + _lhsOself :: Expression + _lhsOself = rule1045 _self + _lhsObeta :: Tp + _lhsObeta = rule1046 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1047 _rightExpressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1048 _rightExpressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1049 _rightExpressionIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule1050 _rightExpressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1051 _rightExpressionIdictionaryEnvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1052 _rightExpressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1053 _rightExpressionIuniqueChunk + _leftExpressionOallPatterns = rule1054 _lhsIallPatterns + _leftExpressionOallTypeSchemes = rule1055 _lhsIallTypeSchemes + _leftExpressionOavailablePredicates = rule1056 _lhsIavailablePredicates + _leftExpressionOclassEnvironment = rule1057 _lhsIclassEnvironment + _leftExpressionOcollectErrors = rule1058 _lhsIcollectErrors + _leftExpressionOcollectWarnings = rule1059 _lhsIcollectWarnings + _leftExpressionOcounter = rule1060 _lhsIcounter + _leftExpressionOcurrentChunk = rule1061 _lhsIcurrentChunk + _leftExpressionOdictionaryEnvironment = rule1062 _lhsIdictionaryEnvironment + _leftExpressionOimportEnvironment = rule1063 _lhsIimportEnvironment + _leftExpressionOmatchIO = rule1064 _lhsImatchIO + _leftExpressionOmonos = rule1065 _lhsImonos + _leftExpressionOnamesInScope = rule1066 _lhsInamesInScope + _leftExpressionOorderedTypeSynonyms = rule1067 _lhsIorderedTypeSynonyms + _leftExpressionOparentTree = rule1068 _parentTree + _leftExpressionOpatternMatchWarnings = rule1069 _lhsIpatternMatchWarnings + _leftExpressionOsubstitution = rule1070 _lhsIsubstitution + _leftExpressionOtypeschemeMap = rule1071 _lhsItypeschemeMap + _leftExpressionOuniqueChunk = rule1072 _lhsIuniqueChunk + _leftExpressionOuniqueSecondRound = rule1073 _lhsIuniqueSecondRound + _operatorOallPatterns = rule1074 _lhsIallPatterns + _operatorOallTypeSchemes = rule1075 _lhsIallTypeSchemes + _operatorOavailablePredicates = rule1076 _lhsIavailablePredicates + _operatorObetaUnique = rule1077 _leftExpressionIbetaUnique + _operatorOclassEnvironment = rule1078 _lhsIclassEnvironment + _operatorOcollectErrors = rule1079 _leftExpressionIcollectErrors + _operatorOcollectWarnings = rule1080 _leftExpressionIcollectWarnings + _operatorOcounter = rule1081 _leftExpressionIcounter + _operatorOcurrentChunk = rule1082 _lhsIcurrentChunk + _operatorOdictionaryEnvironment = rule1083 _leftExpressionIdictionaryEnvironment + _operatorOimportEnvironment = rule1084 _lhsIimportEnvironment + _operatorOmatchIO = rule1085 _leftExpressionImatchIO + _operatorOmonos = rule1086 _lhsImonos + _operatorOnamesInScope = rule1087 _lhsInamesInScope + _operatorOorderedTypeSynonyms = rule1088 _lhsIorderedTypeSynonyms + _operatorOparentTree = rule1089 _parentTree + _operatorOpatternMatchWarnings = rule1090 _leftExpressionIpatternMatchWarnings + _operatorOsubstitution = rule1091 _lhsIsubstitution + _operatorOtypeschemeMap = rule1092 _lhsItypeschemeMap + _operatorOuniqueChunk = rule1093 _leftExpressionIuniqueChunk + _operatorOuniqueSecondRound = rule1094 _leftExpressionIuniqueSecondRound + _rightExpressionOallPatterns = rule1095 _lhsIallPatterns + _rightExpressionOallTypeSchemes = rule1096 _lhsIallTypeSchemes + _rightExpressionOavailablePredicates = rule1097 _lhsIavailablePredicates + _rightExpressionObetaUnique = rule1098 _operatorIbetaUnique + _rightExpressionOclassEnvironment = rule1099 _lhsIclassEnvironment + _rightExpressionOcollectErrors = rule1100 _operatorIcollectErrors + _rightExpressionOcollectWarnings = rule1101 _operatorIcollectWarnings + _rightExpressionOcounter = rule1102 _operatorIcounter + _rightExpressionOcurrentChunk = rule1103 _lhsIcurrentChunk + _rightExpressionOdictionaryEnvironment = rule1104 _operatorIdictionaryEnvironment + _rightExpressionOimportEnvironment = rule1105 _lhsIimportEnvironment + _rightExpressionOmatchIO = rule1106 _operatorImatchIO + _rightExpressionOmonos = rule1107 _lhsImonos + _rightExpressionOnamesInScope = rule1108 _lhsInamesInScope + _rightExpressionOorderedTypeSynonyms = rule1109 _lhsIorderedTypeSynonyms + _rightExpressionOparentTree = rule1110 _parentTree + _rightExpressionOpatternMatchWarnings = rule1111 _operatorIpatternMatchWarnings + _rightExpressionOsubstitution = rule1112 _lhsIsubstitution + _rightExpressionOtypeschemeMap = rule1113 _lhsItypeschemeMap + _rightExpressionOuniqueChunk = rule1114 _operatorIuniqueChunk + _rightExpressionOuniqueSecondRound = rule1115 _operatorIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1024 #-} + rule1024 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 2 + {-# INLINE rule1025 #-} + rule1025 = \ ((_leftExpressionIassumptions) :: Assumptions) ((_operatorIassumptions) :: Assumptions) ((_rightExpressionIassumptions) :: Assumptions) -> + _leftExpressionIassumptions `combine` _operatorIassumptions `combine` _rightExpressionIassumptions + {-# INLINE rule1026 #-} + rule1026 = \ _conTotal ((_leftExpressionIconstraints) :: ConstraintSet) ((_operatorIconstraints) :: ConstraintSet) ((_rightExpressionIconstraints) :: ConstraintSet) -> + _conTotal .>. + Node [ _operatorIconstraints + , _leftExpressionIconstraints + , _rightExpressionIconstraints + ] + {-# INLINE rule1027 #-} + rule1027 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1028 #-} + rule1028 = \ ((_lhsIbetaUnique) :: Int) -> + TVar (_lhsIbetaUnique + 1) + {-# INLINE rule1029 #-} + rule1029 = \ _betaResOp _cinfoOperator ((_leftExpressionIbeta) :: Tp) ((_operatorIbeta) :: Tp) ((_rightExpressionIbeta) :: Tp) -> + (_operatorIbeta .==. _leftExpressionIbeta .->. _rightExpressionIbeta .->. _betaResOp) _cinfoOperator + {-# INLINE rule1030 #-} + rule1030 = \ _beta _betaResOp _cinfoComplete _cinfoEmpty _cinfoLeftSection _cinfoRightSection _conOperator ((_leftExpressionIbeta) :: Tp) ((_leftExpressionIsection) :: Bool) ((_operatorIbeta) :: Tp) ((_rightExpressionIbeta) :: Tp) ((_rightExpressionIsection) :: Bool) -> + case (_leftExpressionIsection,_rightExpressionIsection) of + (False,False) -> [ _conOperator, (_betaResOp .==. _beta) _cinfoComplete ] + (True ,True ) -> [ (_operatorIbeta .==. _beta) _cinfoEmpty ] + (False,True ) -> [ _conOperator, (_rightExpressionIbeta .->. _betaResOp .==. _beta) _cinfoRightSection ] + (True ,False) -> [ _conOperator, (_leftExpressionIbeta .->. _betaResOp .==. _beta) _cinfoLeftSection ] + {-# INLINE rule1031 #-} + rule1031 = \ ((_leftExpressionIinfoTrees) :: InfoTrees) -> + length _leftExpressionIinfoTrees + {-# INLINE rule1032 #-} + rule1032 = \ ((_leftExpressionIinfoTrees) :: InfoTrees) ((_leftExpressionIsection) :: Bool) _operatorNr _parentTree ((_rightExpressionIinfoTrees) :: InfoTrees) ((_rightExpressionIsection) :: Bool) -> + childConstraint _operatorNr "infix application" _parentTree $ + if _leftExpressionIsection || _rightExpressionIsection + then [ HasTrustFactor 10.0 ] + else [ ApplicationEdge True (map attribute (_leftExpressionIinfoTrees ++ _rightExpressionIinfoTrees)) ] + {-# INLINE rule1033 #-} + rule1033 = \ _localInfo _parentTree -> + specialConstraint "infix application (INTERNAL ERROR)" _parentTree + (self _localInfo, Nothing) + [ FolkloreConstraint, highlyTrusted ] + {-# INLINE rule1034 #-} + rule1034 = \ _localInfo _parentTree -> + specialConstraint "left section" _parentTree + (self _localInfo, Nothing) + [ ] + {-# INLINE rule1035 #-} + rule1035 = \ _localInfo _parentTree -> + specialConstraint "right section" _parentTree + (self _localInfo, Nothing) + [ ] + {-# INLINE rule1036 #-} + rule1036 = \ _localInfo _parentTree -> + specialConstraint "infix application" _parentTree + (self _localInfo, Nothing) + [ FolkloreConstraint, HasTrustFactor 10.0 ] + {-# INLINE rule1037 #-} + rule1037 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1038 #-} + rule1038 = \ ((_leftExpressionIinfoTrees) :: InfoTrees) ((_lhsIparentTree) :: InfoTree) _localInfo ((_operatorIinfoTree) :: InfoTree) ((_rightExpressionIinfoTrees) :: InfoTrees) -> + node _lhsIparentTree _localInfo + (_leftExpressionIinfoTrees ++ [_operatorIinfoTree] ++ _rightExpressionIinfoTrees) + {-# INLINE rule1039 #-} + rule1039 = \ _parentTree -> + _parentTree + {-# INLINE rule1040 #-} + rule1040 = \ _assumptions _constraints ((_leftExpressionImatches) :: [Maybe MetaVariableTable]) ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo ((_operatorImatches) :: [Maybe MetaVariableTable]) ((_rightExpressionImatches) :: [Maybe MetaVariableTable]) ((_rightExpressionIuniqueSecondRound) :: Int) -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in match3 infoTuple _rightExpressionIuniqueSecondRound + match_Expression_InfixApplication + _lhsItryPatterns _lhsIallPatterns + [_leftExpressionImatches, _operatorImatches,_rightExpressionImatches] + {-# INLINE rule1041 #-} + rule1041 = \ _ioMatch ((_rightExpressionImatchIO) :: IO ()) -> + _rightExpressionImatchIO >> _ioMatch + {-# INLINE rule1042 #-} + rule1042 = \ ((_leftExpressionIcollectInstances) :: [(Name, Instance)]) ((_operatorIcollectInstances) :: [(Name, Instance)]) ((_rightExpressionIcollectInstances) :: [(Name, Instance)]) -> + _leftExpressionIcollectInstances ++ _operatorIcollectInstances ++ _rightExpressionIcollectInstances + {-# INLINE rule1043 #-} + rule1043 = \ ((_leftExpressionIunboundNames) :: Names) ((_operatorIunboundNames) :: Names) ((_rightExpressionIunboundNames) :: Names) -> + _leftExpressionIunboundNames ++ _operatorIunboundNames ++ _rightExpressionIunboundNames + {-# INLINE rule1044 #-} + rule1044 = \ ((_leftExpressionIself) :: MaybeExpression) ((_operatorIself) :: Expression) ((_rangeIself) :: Range) ((_rightExpressionIself) :: MaybeExpression) -> + Expression_InfixApplication _rangeIself _leftExpressionIself _operatorIself _rightExpressionIself + {-# INLINE rule1045 #-} + rule1045 = \ _self -> + _self + {-# INLINE rule1046 #-} + rule1046 = \ _beta -> + _beta + {-# INLINE rule1047 #-} + rule1047 = \ ((_rightExpressionIbetaUnique) :: Int) -> + _rightExpressionIbetaUnique + {-# INLINE rule1048 #-} + rule1048 = \ ((_rightExpressionIcollectErrors) :: TypeErrors) -> + _rightExpressionIcollectErrors + {-# INLINE rule1049 #-} + rule1049 = \ ((_rightExpressionIcollectWarnings) :: Warnings) -> + _rightExpressionIcollectWarnings + {-# INLINE rule1050 #-} + rule1050 = \ ((_rightExpressionIcounter) :: Int) -> + _rightExpressionIcounter + {-# INLINE rule1051 #-} + rule1051 = \ ((_rightExpressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _rightExpressionIdictionaryEnvironment + {-# INLINE rule1052 #-} + rule1052 = \ ((_rightExpressionIpatternMatchWarnings) :: [Warning]) -> + _rightExpressionIpatternMatchWarnings + {-# INLINE rule1053 #-} + rule1053 = \ ((_rightExpressionIuniqueChunk) :: Int) -> + _rightExpressionIuniqueChunk + {-# INLINE rule1054 #-} + rule1054 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1055 #-} + rule1055 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1056 #-} + rule1056 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1057 #-} + rule1057 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1058 #-} + rule1058 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1059 #-} + rule1059 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1060 #-} + rule1060 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1061 #-} + rule1061 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1062 #-} + rule1062 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1063 #-} + rule1063 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1064 #-} + rule1064 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1065 #-} + rule1065 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1066 #-} + rule1066 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1067 #-} + rule1067 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1068 #-} + rule1068 = \ _parentTree -> + _parentTree + {-# INLINE rule1069 #-} + rule1069 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1070 #-} + rule1070 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1071 #-} + rule1071 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1072 #-} + rule1072 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1073 #-} + rule1073 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule1074 #-} + rule1074 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1075 #-} + rule1075 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1076 #-} + rule1076 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1077 #-} + rule1077 = \ ((_leftExpressionIbetaUnique) :: Int) -> + _leftExpressionIbetaUnique + {-# INLINE rule1078 #-} + rule1078 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1079 #-} + rule1079 = \ ((_leftExpressionIcollectErrors) :: TypeErrors) -> + _leftExpressionIcollectErrors + {-# INLINE rule1080 #-} + rule1080 = \ ((_leftExpressionIcollectWarnings) :: Warnings) -> + _leftExpressionIcollectWarnings + {-# INLINE rule1081 #-} + rule1081 = \ ((_leftExpressionIcounter) :: Int) -> + _leftExpressionIcounter + {-# INLINE rule1082 #-} + rule1082 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1083 #-} + rule1083 = \ ((_leftExpressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _leftExpressionIdictionaryEnvironment + {-# INLINE rule1084 #-} + rule1084 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1085 #-} + rule1085 = \ ((_leftExpressionImatchIO) :: IO ()) -> + _leftExpressionImatchIO + {-# INLINE rule1086 #-} + rule1086 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1087 #-} + rule1087 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1088 #-} + rule1088 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1089 #-} + rule1089 = \ _parentTree -> + _parentTree + {-# INLINE rule1090 #-} + rule1090 = \ ((_leftExpressionIpatternMatchWarnings) :: [Warning]) -> + _leftExpressionIpatternMatchWarnings + {-# INLINE rule1091 #-} + rule1091 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1092 #-} + rule1092 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1093 #-} + rule1093 = \ ((_leftExpressionIuniqueChunk) :: Int) -> + _leftExpressionIuniqueChunk + {-# INLINE rule1094 #-} + rule1094 = \ ((_leftExpressionIuniqueSecondRound) :: Int) -> + _leftExpressionIuniqueSecondRound + {-# INLINE rule1095 #-} + rule1095 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1096 #-} + rule1096 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1097 #-} + rule1097 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1098 #-} + rule1098 = \ ((_operatorIbetaUnique) :: Int) -> + _operatorIbetaUnique + {-# INLINE rule1099 #-} + rule1099 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1100 #-} + rule1100 = \ ((_operatorIcollectErrors) :: TypeErrors) -> + _operatorIcollectErrors + {-# INLINE rule1101 #-} + rule1101 = \ ((_operatorIcollectWarnings) :: Warnings) -> + _operatorIcollectWarnings + {-# INLINE rule1102 #-} + rule1102 = \ ((_operatorIcounter) :: Int) -> + _operatorIcounter + {-# INLINE rule1103 #-} + rule1103 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1104 #-} + rule1104 = \ ((_operatorIdictionaryEnvironment) :: DictionaryEnvironment) -> + _operatorIdictionaryEnvironment + {-# INLINE rule1105 #-} + rule1105 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1106 #-} + rule1106 = \ ((_operatorImatchIO) :: IO ()) -> + _operatorImatchIO + {-# INLINE rule1107 #-} + rule1107 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1108 #-} + rule1108 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1109 #-} + rule1109 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1110 #-} + rule1110 = \ _parentTree -> + _parentTree + {-# INLINE rule1111 #-} + rule1111 = \ ((_operatorIpatternMatchWarnings) :: [Warning]) -> + _operatorIpatternMatchWarnings + {-# INLINE rule1112 #-} + rule1112 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1113 #-} + rule1113 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1114 #-} + rule1114 = \ ((_operatorIuniqueChunk) :: Int) -> + _operatorIuniqueChunk + {-# INLINE rule1115 #-} + rule1115 = \ ((_operatorIuniqueSecondRound) :: Int) -> + _operatorIuniqueSecondRound +{-# NOINLINE sem_Expression_If #-} +sem_Expression_If :: T_Range -> T_Expression -> T_Expression -> T_Expression -> T_Expression +sem_Expression_If arg_range_ arg_guardExpression_ arg_thenExpression_ arg_elseExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guardExpression_)) + _thenExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_thenExpression_)) + _elseExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_elseExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardExpressionIassumptions _guardExpressionIbeta _guardExpressionIbetaUnique _guardExpressionIcollectErrors _guardExpressionIcollectInstances _guardExpressionIcollectWarnings _guardExpressionIconstraints _guardExpressionIcounter _guardExpressionIdictionaryEnvironment _guardExpressionIinfoTree _guardExpressionImatchIO _guardExpressionImatches _guardExpressionIpatternMatchWarnings _guardExpressionIself _guardExpressionIunboundNames _guardExpressionIuniqueChunk _guardExpressionIuniqueSecondRound) = inv_Expression_s41 _guardExpressionX41 (T_Expression_vIn40 _guardExpressionOallPatterns _guardExpressionOallTypeSchemes _guardExpressionOavailablePredicates _guardExpressionObetaUnique _guardExpressionOclassEnvironment _guardExpressionOcollectErrors _guardExpressionOcollectWarnings _guardExpressionOcounter _guardExpressionOcurrentChunk _guardExpressionOdictionaryEnvironment _guardExpressionOimportEnvironment _guardExpressionOmatchIO _guardExpressionOmonos _guardExpressionOnamesInScope _guardExpressionOorderedTypeSynonyms _guardExpressionOparentTree _guardExpressionOpatternMatchWarnings _guardExpressionOsubstitution _guardExpressionOtryPatterns _guardExpressionOtypeschemeMap _guardExpressionOuniqueChunk _guardExpressionOuniqueSecondRound) + (T_Expression_vOut40 _thenExpressionIassumptions _thenExpressionIbeta _thenExpressionIbetaUnique _thenExpressionIcollectErrors _thenExpressionIcollectInstances _thenExpressionIcollectWarnings _thenExpressionIconstraints _thenExpressionIcounter _thenExpressionIdictionaryEnvironment _thenExpressionIinfoTree _thenExpressionImatchIO _thenExpressionImatches _thenExpressionIpatternMatchWarnings _thenExpressionIself _thenExpressionIunboundNames _thenExpressionIuniqueChunk _thenExpressionIuniqueSecondRound) = inv_Expression_s41 _thenExpressionX41 (T_Expression_vIn40 _thenExpressionOallPatterns _thenExpressionOallTypeSchemes _thenExpressionOavailablePredicates _thenExpressionObetaUnique _thenExpressionOclassEnvironment _thenExpressionOcollectErrors _thenExpressionOcollectWarnings _thenExpressionOcounter _thenExpressionOcurrentChunk _thenExpressionOdictionaryEnvironment _thenExpressionOimportEnvironment _thenExpressionOmatchIO _thenExpressionOmonos _thenExpressionOnamesInScope _thenExpressionOorderedTypeSynonyms _thenExpressionOparentTree _thenExpressionOpatternMatchWarnings _thenExpressionOsubstitution _thenExpressionOtryPatterns _thenExpressionOtypeschemeMap _thenExpressionOuniqueChunk _thenExpressionOuniqueSecondRound) + (T_Expression_vOut40 _elseExpressionIassumptions _elseExpressionIbeta _elseExpressionIbetaUnique _elseExpressionIcollectErrors _elseExpressionIcollectInstances _elseExpressionIcollectWarnings _elseExpressionIconstraints _elseExpressionIcounter _elseExpressionIdictionaryEnvironment _elseExpressionIinfoTree _elseExpressionImatchIO _elseExpressionImatches _elseExpressionIpatternMatchWarnings _elseExpressionIself _elseExpressionIunboundNames _elseExpressionIuniqueChunk _elseExpressionIuniqueSecondRound) = inv_Expression_s41 _elseExpressionX41 (T_Expression_vIn40 _elseExpressionOallPatterns _elseExpressionOallTypeSchemes _elseExpressionOavailablePredicates _elseExpressionObetaUnique _elseExpressionOclassEnvironment _elseExpressionOcollectErrors _elseExpressionOcollectWarnings _elseExpressionOcounter _elseExpressionOcurrentChunk _elseExpressionOdictionaryEnvironment _elseExpressionOimportEnvironment _elseExpressionOmatchIO _elseExpressionOmonos _elseExpressionOnamesInScope _elseExpressionOorderedTypeSynonyms _elseExpressionOparentTree _elseExpressionOpatternMatchWarnings _elseExpressionOsubstitution _elseExpressionOtryPatterns _elseExpressionOtypeschemeMap _elseExpressionOuniqueChunk _elseExpressionOuniqueSecondRound) + _guardExpressionObetaUnique = rule1116 _lhsIbetaUnique + _assumptions = rule1117 _elseExpressionIassumptions _guardExpressionIassumptions _thenExpressionIassumptions + _constraints = rule1118 _conElse _conGuard _conThen _elseExpressionIconstraints _guardExpressionIconstraints _thenExpressionIconstraints + _beta = rule1119 _lhsIbetaUnique + _conGuard = rule1120 _cinfoGuard _guardExpressionIbeta + _conThen = rule1121 _beta _cinfoThen _thenExpressionIbeta + _conElse = rule1122 _beta _cinfoElse _elseExpressionIbeta + _cinfoGuard = rule1123 _parentTree + _cinfoThen = rule1124 _beta _localInfo _parentTree + _cinfoElse = rule1125 _beta _localInfo _parentTree + _localInfo = rule1126 _beta _lhsImonos _self + _parentTree = rule1127 _elseExpressionIinfoTree _guardExpressionIinfoTree _lhsIparentTree _localInfo _thenExpressionIinfoTree + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1128 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + ((_guardExpressionOtryPatterns,_thenExpressionOtryPatterns,_elseExpressionOtryPatterns),_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule1129 _assumptions _constraints _elseExpressionImatches _elseExpressionIuniqueSecondRound _guardExpressionImatches _lhsIallPatterns _lhsItryPatterns _localInfo _thenExpressionImatches + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1130 _elseExpressionImatchIO _ioMatch + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1131 _elseExpressionIcollectInstances _guardExpressionIcollectInstances _thenExpressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1132 _elseExpressionIunboundNames _guardExpressionIunboundNames _thenExpressionIunboundNames + _self = rule1133 _elseExpressionIself _guardExpressionIself _rangeIself _thenExpressionIself + _lhsOself :: Expression + _lhsOself = rule1134 _self + _lhsObeta :: Tp + _lhsObeta = rule1135 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1136 _elseExpressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1137 _elseExpressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1138 _elseExpressionIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule1139 _elseExpressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1140 _elseExpressionIdictionaryEnvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1141 _elseExpressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1142 _elseExpressionIuniqueChunk + _guardExpressionOallPatterns = rule1143 _lhsIallPatterns + _guardExpressionOallTypeSchemes = rule1144 _lhsIallTypeSchemes + _guardExpressionOavailablePredicates = rule1145 _lhsIavailablePredicates + _guardExpressionOclassEnvironment = rule1146 _lhsIclassEnvironment + _guardExpressionOcollectErrors = rule1147 _lhsIcollectErrors + _guardExpressionOcollectWarnings = rule1148 _lhsIcollectWarnings + _guardExpressionOcounter = rule1149 _lhsIcounter + _guardExpressionOcurrentChunk = rule1150 _lhsIcurrentChunk + _guardExpressionOdictionaryEnvironment = rule1151 _lhsIdictionaryEnvironment + _guardExpressionOimportEnvironment = rule1152 _lhsIimportEnvironment + _guardExpressionOmatchIO = rule1153 _lhsImatchIO + _guardExpressionOmonos = rule1154 _lhsImonos + _guardExpressionOnamesInScope = rule1155 _lhsInamesInScope + _guardExpressionOorderedTypeSynonyms = rule1156 _lhsIorderedTypeSynonyms + _guardExpressionOparentTree = rule1157 _parentTree + _guardExpressionOpatternMatchWarnings = rule1158 _lhsIpatternMatchWarnings + _guardExpressionOsubstitution = rule1159 _lhsIsubstitution + _guardExpressionOtypeschemeMap = rule1160 _lhsItypeschemeMap + _guardExpressionOuniqueChunk = rule1161 _lhsIuniqueChunk + _guardExpressionOuniqueSecondRound = rule1162 _lhsIuniqueSecondRound + _thenExpressionOallPatterns = rule1163 _lhsIallPatterns + _thenExpressionOallTypeSchemes = rule1164 _lhsIallTypeSchemes + _thenExpressionOavailablePredicates = rule1165 _lhsIavailablePredicates + _thenExpressionObetaUnique = rule1166 _guardExpressionIbetaUnique + _thenExpressionOclassEnvironment = rule1167 _lhsIclassEnvironment + _thenExpressionOcollectErrors = rule1168 _guardExpressionIcollectErrors + _thenExpressionOcollectWarnings = rule1169 _guardExpressionIcollectWarnings + _thenExpressionOcounter = rule1170 _guardExpressionIcounter + _thenExpressionOcurrentChunk = rule1171 _lhsIcurrentChunk + _thenExpressionOdictionaryEnvironment = rule1172 _guardExpressionIdictionaryEnvironment + _thenExpressionOimportEnvironment = rule1173 _lhsIimportEnvironment + _thenExpressionOmatchIO = rule1174 _guardExpressionImatchIO + _thenExpressionOmonos = rule1175 _lhsImonos + _thenExpressionOnamesInScope = rule1176 _lhsInamesInScope + _thenExpressionOorderedTypeSynonyms = rule1177 _lhsIorderedTypeSynonyms + _thenExpressionOparentTree = rule1178 _parentTree + _thenExpressionOpatternMatchWarnings = rule1179 _guardExpressionIpatternMatchWarnings + _thenExpressionOsubstitution = rule1180 _lhsIsubstitution + _thenExpressionOtypeschemeMap = rule1181 _lhsItypeschemeMap + _thenExpressionOuniqueChunk = rule1182 _guardExpressionIuniqueChunk + _thenExpressionOuniqueSecondRound = rule1183 _guardExpressionIuniqueSecondRound + _elseExpressionOallPatterns = rule1184 _lhsIallPatterns + _elseExpressionOallTypeSchemes = rule1185 _lhsIallTypeSchemes + _elseExpressionOavailablePredicates = rule1186 _lhsIavailablePredicates + _elseExpressionObetaUnique = rule1187 _thenExpressionIbetaUnique + _elseExpressionOclassEnvironment = rule1188 _lhsIclassEnvironment + _elseExpressionOcollectErrors = rule1189 _thenExpressionIcollectErrors + _elseExpressionOcollectWarnings = rule1190 _thenExpressionIcollectWarnings + _elseExpressionOcounter = rule1191 _thenExpressionIcounter + _elseExpressionOcurrentChunk = rule1192 _lhsIcurrentChunk + _elseExpressionOdictionaryEnvironment = rule1193 _thenExpressionIdictionaryEnvironment + _elseExpressionOimportEnvironment = rule1194 _lhsIimportEnvironment + _elseExpressionOmatchIO = rule1195 _thenExpressionImatchIO + _elseExpressionOmonos = rule1196 _lhsImonos + _elseExpressionOnamesInScope = rule1197 _lhsInamesInScope + _elseExpressionOorderedTypeSynonyms = rule1198 _lhsIorderedTypeSynonyms + _elseExpressionOparentTree = rule1199 _parentTree + _elseExpressionOpatternMatchWarnings = rule1200 _thenExpressionIpatternMatchWarnings + _elseExpressionOsubstitution = rule1201 _lhsIsubstitution + _elseExpressionOtypeschemeMap = rule1202 _lhsItypeschemeMap + _elseExpressionOuniqueChunk = rule1203 _thenExpressionIuniqueChunk + _elseExpressionOuniqueSecondRound = rule1204 _thenExpressionIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1116 #-} + rule1116 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule1117 #-} + rule1117 = \ ((_elseExpressionIassumptions) :: Assumptions) ((_guardExpressionIassumptions) :: Assumptions) ((_thenExpressionIassumptions) :: Assumptions) -> + _guardExpressionIassumptions `combine` _thenExpressionIassumptions `combine` _elseExpressionIassumptions + {-# INLINE rule1118 #-} + rule1118 = \ _conElse _conGuard _conThen ((_elseExpressionIconstraints) :: ConstraintSet) ((_guardExpressionIconstraints) :: ConstraintSet) ((_thenExpressionIconstraints) :: ConstraintSet) -> + Node [ _conGuard .<. _guardExpressionIconstraints + , _conThen .<. _thenExpressionIconstraints + , _conElse .<. _elseExpressionIconstraints + ] + {-# INLINE rule1119 #-} + rule1119 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1120 #-} + rule1120 = \ _cinfoGuard ((_guardExpressionIbeta) :: Tp) -> + [ (_guardExpressionIbeta .==. boolType) _cinfoGuard ] + {-# INLINE rule1121 #-} + rule1121 = \ _beta _cinfoThen ((_thenExpressionIbeta) :: Tp) -> + [ (_thenExpressionIbeta .==. _beta ) _cinfoThen ] + {-# INLINE rule1122 #-} + rule1122 = \ _beta _cinfoElse ((_elseExpressionIbeta) :: Tp) -> + [ (_elseExpressionIbeta .==. _beta ) _cinfoElse ] + {-# INLINE rule1123 #-} + rule1123 = \ _parentTree -> + childConstraint 0 "conditional" _parentTree + [] + {-# INLINE rule1124 #-} + rule1124 = \ _beta _localInfo _parentTree -> + childConstraint 1 "then branch of conditional" _parentTree + [ Unifier (head (ftv _beta)) ("conditional", _localInfo, "then branch") ] + {-# INLINE rule1125 #-} + rule1125 = \ _beta _localInfo _parentTree -> + childConstraint 2 "else branch of conditional" _parentTree + [ Unifier (head (ftv _beta)) ("conditional", _localInfo, "else branch") ] + {-# INLINE rule1126 #-} + rule1126 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1127 #-} + rule1127 = \ ((_elseExpressionIinfoTree) :: InfoTree) ((_guardExpressionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo ((_thenExpressionIinfoTree) :: InfoTree) -> + node _lhsIparentTree _localInfo [_guardExpressionIinfoTree, _thenExpressionIinfoTree, _elseExpressionIinfoTree] + {-# INLINE rule1128 #-} + rule1128 = \ _parentTree -> + _parentTree + {-# INLINE rule1129 #-} + rule1129 = \ _assumptions _constraints ((_elseExpressionImatches) :: [Maybe MetaVariableTable]) ((_elseExpressionIuniqueSecondRound) :: Int) ((_guardExpressionImatches) :: [Maybe MetaVariableTable]) ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo ((_thenExpressionImatches) :: [Maybe MetaVariableTable]) -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in match3 infoTuple _elseExpressionIuniqueSecondRound + match_Expression_If + _lhsItryPatterns _lhsIallPatterns + [_guardExpressionImatches,_thenExpressionImatches,_elseExpressionImatches] + {-# INLINE rule1130 #-} + rule1130 = \ ((_elseExpressionImatchIO) :: IO ()) _ioMatch -> + _elseExpressionImatchIO >> _ioMatch + {-# INLINE rule1131 #-} + rule1131 = \ ((_elseExpressionIcollectInstances) :: [(Name, Instance)]) ((_guardExpressionIcollectInstances) :: [(Name, Instance)]) ((_thenExpressionIcollectInstances) :: [(Name, Instance)]) -> + _guardExpressionIcollectInstances ++ _thenExpressionIcollectInstances ++ _elseExpressionIcollectInstances + {-# INLINE rule1132 #-} + rule1132 = \ ((_elseExpressionIunboundNames) :: Names) ((_guardExpressionIunboundNames) :: Names) ((_thenExpressionIunboundNames) :: Names) -> + _guardExpressionIunboundNames ++ _thenExpressionIunboundNames ++ _elseExpressionIunboundNames + {-# INLINE rule1133 #-} + rule1133 = \ ((_elseExpressionIself) :: Expression) ((_guardExpressionIself) :: Expression) ((_rangeIself) :: Range) ((_thenExpressionIself) :: Expression) -> + Expression_If _rangeIself _guardExpressionIself _thenExpressionIself _elseExpressionIself + {-# INLINE rule1134 #-} + rule1134 = \ _self -> + _self + {-# INLINE rule1135 #-} + rule1135 = \ _beta -> + _beta + {-# INLINE rule1136 #-} + rule1136 = \ ((_elseExpressionIbetaUnique) :: Int) -> + _elseExpressionIbetaUnique + {-# INLINE rule1137 #-} + rule1137 = \ ((_elseExpressionIcollectErrors) :: TypeErrors) -> + _elseExpressionIcollectErrors + {-# INLINE rule1138 #-} + rule1138 = \ ((_elseExpressionIcollectWarnings) :: Warnings) -> + _elseExpressionIcollectWarnings + {-# INLINE rule1139 #-} + rule1139 = \ ((_elseExpressionIcounter) :: Int) -> + _elseExpressionIcounter + {-# INLINE rule1140 #-} + rule1140 = \ ((_elseExpressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _elseExpressionIdictionaryEnvironment + {-# INLINE rule1141 #-} + rule1141 = \ ((_elseExpressionIpatternMatchWarnings) :: [Warning]) -> + _elseExpressionIpatternMatchWarnings + {-# INLINE rule1142 #-} + rule1142 = \ ((_elseExpressionIuniqueChunk) :: Int) -> + _elseExpressionIuniqueChunk + {-# INLINE rule1143 #-} + rule1143 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1144 #-} + rule1144 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1145 #-} + rule1145 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1146 #-} + rule1146 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1147 #-} + rule1147 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1148 #-} + rule1148 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1149 #-} + rule1149 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1150 #-} + rule1150 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1151 #-} + rule1151 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1152 #-} + rule1152 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1153 #-} + rule1153 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1154 #-} + rule1154 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1155 #-} + rule1155 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1156 #-} + rule1156 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1157 #-} + rule1157 = \ _parentTree -> + _parentTree + {-# INLINE rule1158 #-} + rule1158 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1159 #-} + rule1159 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1160 #-} + rule1160 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1161 #-} + rule1161 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1162 #-} + rule1162 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule1163 #-} + rule1163 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1164 #-} + rule1164 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1165 #-} + rule1165 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1166 #-} + rule1166 = \ ((_guardExpressionIbetaUnique) :: Int) -> + _guardExpressionIbetaUnique + {-# INLINE rule1167 #-} + rule1167 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1168 #-} + rule1168 = \ ((_guardExpressionIcollectErrors) :: TypeErrors) -> + _guardExpressionIcollectErrors + {-# INLINE rule1169 #-} + rule1169 = \ ((_guardExpressionIcollectWarnings) :: Warnings) -> + _guardExpressionIcollectWarnings + {-# INLINE rule1170 #-} + rule1170 = \ ((_guardExpressionIcounter) :: Int) -> + _guardExpressionIcounter + {-# INLINE rule1171 #-} + rule1171 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1172 #-} + rule1172 = \ ((_guardExpressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _guardExpressionIdictionaryEnvironment + {-# INLINE rule1173 #-} + rule1173 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1174 #-} + rule1174 = \ ((_guardExpressionImatchIO) :: IO ()) -> + _guardExpressionImatchIO + {-# INLINE rule1175 #-} + rule1175 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1176 #-} + rule1176 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1177 #-} + rule1177 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1178 #-} + rule1178 = \ _parentTree -> + _parentTree + {-# INLINE rule1179 #-} + rule1179 = \ ((_guardExpressionIpatternMatchWarnings) :: [Warning]) -> + _guardExpressionIpatternMatchWarnings + {-# INLINE rule1180 #-} + rule1180 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1181 #-} + rule1181 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1182 #-} + rule1182 = \ ((_guardExpressionIuniqueChunk) :: Int) -> + _guardExpressionIuniqueChunk + {-# INLINE rule1183 #-} + rule1183 = \ ((_guardExpressionIuniqueSecondRound) :: Int) -> + _guardExpressionIuniqueSecondRound + {-# INLINE rule1184 #-} + rule1184 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1185 #-} + rule1185 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1186 #-} + rule1186 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1187 #-} + rule1187 = \ ((_thenExpressionIbetaUnique) :: Int) -> + _thenExpressionIbetaUnique + {-# INLINE rule1188 #-} + rule1188 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1189 #-} + rule1189 = \ ((_thenExpressionIcollectErrors) :: TypeErrors) -> + _thenExpressionIcollectErrors + {-# INLINE rule1190 #-} + rule1190 = \ ((_thenExpressionIcollectWarnings) :: Warnings) -> + _thenExpressionIcollectWarnings + {-# INLINE rule1191 #-} + rule1191 = \ ((_thenExpressionIcounter) :: Int) -> + _thenExpressionIcounter + {-# INLINE rule1192 #-} + rule1192 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1193 #-} + rule1193 = \ ((_thenExpressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _thenExpressionIdictionaryEnvironment + {-# INLINE rule1194 #-} + rule1194 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1195 #-} + rule1195 = \ ((_thenExpressionImatchIO) :: IO ()) -> + _thenExpressionImatchIO + {-# INLINE rule1196 #-} + rule1196 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1197 #-} + rule1197 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1198 #-} + rule1198 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1199 #-} + rule1199 = \ _parentTree -> + _parentTree + {-# INLINE rule1200 #-} + rule1200 = \ ((_thenExpressionIpatternMatchWarnings) :: [Warning]) -> + _thenExpressionIpatternMatchWarnings + {-# INLINE rule1201 #-} + rule1201 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1202 #-} + rule1202 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1203 #-} + rule1203 = \ ((_thenExpressionIuniqueChunk) :: Int) -> + _thenExpressionIuniqueChunk + {-# INLINE rule1204 #-} + rule1204 = \ ((_thenExpressionIuniqueSecondRound) :: Int) -> + _thenExpressionIuniqueSecondRound +{-# NOINLINE sem_Expression_Lambda #-} +sem_Expression_Lambda :: T_Range -> T_Patterns -> T_Expression -> T_Expression +sem_Expression_Lambda arg_range_ arg_patterns_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIbetaUnique _patternsIbetas _patternsIconstraintslist _patternsIcounter _patternsIelementss _patternsIenvironment _patternsIinfoTrees _patternsInumberOfPatterns _patternsIpatVarNames _patternsIpatternMatchWarnings _patternsIself _patternsIunboundNames) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsObetaUnique _patternsOcounter _patternsOimportEnvironment _patternsOmonos _patternsOnamesInScope _patternsOparentTree _patternsOpatternMatchWarnings) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _patternsObetaUnique = rule1205 _lhsIbetaUnique + _expressionOmonos = rule1206 _csetBinds _lhsImonos _patternsIenvironment + _constraints = rule1207 _csetBinds _expressionIconstraints _newcon _patternsIconstraintslist + _beta = rule1208 _lhsIbetaUnique + _newcon = rule1209 _beta _cinfoType _expressionIbeta _patternsIbetas + (_csetBinds,_assumptions) = rule1210 _cinfoBind _expressionIassumptions _patternsIenvironment + _cinfoBind = rule1211 _parentTree _patternsIenvironment + _cinfoType = rule1212 _parentTree + _localInfo = rule1213 _beta _lhsImonos _self + _parentTree = rule1214 _expressionIinfoTree _lhsIparentTree _localInfo _patternsIinfoTrees + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1215 _parentTree + (_namesInScope,_unboundNames,_scopeInfo) = rule1216 _expressionIunboundNames _lhsInamesInScope _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1217 _unboundNames + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOmatches = rule1218 _assumptions _constraints _lhsItryPatterns _localInfo + _expressionOtryPatterns = rule1219 () + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1220 _beta _expressionIpatternMatchWarnings _lhsIimportEnvironment _lhsIsubstitution _patternsIelementss _patternsIself _rangeIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1221 _expressionIcollectInstances + _self = rule1222 _expressionIself _patternsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1223 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule1224 _assumptions + _lhsObeta :: Tp + _lhsObeta = rule1225 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1226 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1227 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1228 _expressionIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule1229 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule1230 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1231 _expressionIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1232 _expressionImatchIO + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1233 _expressionIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule1234 _expressionIuniqueSecondRound + _patternsOcounter = rule1235 _lhsIcounter + _patternsOimportEnvironment = rule1236 _lhsIimportEnvironment + _patternsOmonos = rule1237 _lhsImonos + _patternsOnamesInScope = rule1238 _namesInScope + _patternsOparentTree = rule1239 _parentTree + _patternsOpatternMatchWarnings = rule1240 _lhsIpatternMatchWarnings + _expressionOallPatterns = rule1241 _lhsIallPatterns + _expressionOallTypeSchemes = rule1242 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule1243 _lhsIavailablePredicates + _expressionObetaUnique = rule1244 _patternsIbetaUnique + _expressionOclassEnvironment = rule1245 _lhsIclassEnvironment + _expressionOcollectErrors = rule1246 _lhsIcollectErrors + _expressionOcollectWarnings = rule1247 _lhsIcollectWarnings + _expressionOcounter = rule1248 _patternsIcounter + _expressionOcurrentChunk = rule1249 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule1250 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule1251 _lhsIimportEnvironment + _expressionOmatchIO = rule1252 _lhsImatchIO + _expressionOnamesInScope = rule1253 _namesInScope + _expressionOorderedTypeSynonyms = rule1254 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule1255 _parentTree + _expressionOpatternMatchWarnings = rule1256 _patternsIpatternMatchWarnings + _expressionOsubstitution = rule1257 _lhsIsubstitution + _expressionOtypeschemeMap = rule1258 _lhsItypeschemeMap + _expressionOuniqueChunk = rule1259 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule1260 _lhsIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1205 #-} + rule1205 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule1206 #-} + rule1206 = \ _csetBinds ((_lhsImonos) :: Monos) ((_patternsIenvironment) :: PatternAssumptions) -> + M.elems _patternsIenvironment ++ getMonos _csetBinds ++ _lhsImonos + {-# INLINE rule1207 #-} + rule1207 = \ _csetBinds ((_expressionIconstraints) :: ConstraintSet) _newcon ((_patternsIconstraintslist) :: ConstraintSets) -> + _newcon .>. _csetBinds .>>. + Node [ Node _patternsIconstraintslist + , _expressionIconstraints + ] + {-# INLINE rule1208 #-} + rule1208 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1209 #-} + rule1209 = \ _beta _cinfoType ((_expressionIbeta) :: Tp) ((_patternsIbetas) :: Tps) -> + [ (foldr (.->.) _expressionIbeta _patternsIbetas .==. _beta) _cinfoType ] + {-# INLINE rule1210 #-} + rule1210 = \ _cinfoBind ((_expressionIassumptions) :: Assumptions) ((_patternsIenvironment) :: PatternAssumptions) -> + (_patternsIenvironment .===. _expressionIassumptions) _cinfoBind + {-# INLINE rule1211 #-} + rule1211 = \ _parentTree ((_patternsIenvironment) :: PatternAssumptions) -> + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint + , makeUnifier name "lambda abstraction" _patternsIenvironment _parentTree + ] + {-# INLINE rule1212 #-} + rule1212 = \ _parentTree -> + resultConstraint "lambda abstraction" _parentTree + [ FolkloreConstraint ] + {-# INLINE rule1213 #-} + rule1213 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1214 #-} + rule1214 = \ ((_expressionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo ((_patternsIinfoTrees) :: InfoTrees) -> + node _lhsIparentTree _localInfo (_patternsIinfoTrees ++ [_expressionIinfoTree]) + {-# INLINE rule1215 #-} + rule1215 = \ _parentTree -> + _parentTree + {-# INLINE rule1216 #-} + rule1216 = \ ((_expressionIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_patternsIpatVarNames) :: Names) -> + changeOfScope _patternsIpatVarNames _expressionIunboundNames _lhsInamesInScope + {-# INLINE rule1217 #-} + rule1217 = \ _unboundNames -> + _unboundNames + {-# INLINE rule1218 #-} + rule1218 = \ _assumptions _constraints ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in matchOnlyVariable infoTuple _lhsItryPatterns + {-# INLINE rule1219 #-} + rule1219 = \ (_ :: ()) -> + [] + {-# INLINE rule1220 #-} + rule1220 = \ _beta ((_expressionIpatternMatchWarnings) :: [Warning]) ((_lhsIimportEnvironment) :: ImportEnvironment) ((_lhsIsubstitution) :: FixpointSubstitution) ((_patternsIelementss) :: [ [PatternElement] ]) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + patternMatchWarnings _lhsIimportEnvironment + _lhsIsubstitution + _beta + (take (length _patternsIself) . fst . functionSpine) + [(concat _patternsIelementss, False)] + _rangeIself + (Just $ Name_Special noRange [] "\\") + True + [] + "lambda expression" + "->" + ++ _expressionIpatternMatchWarnings + {-# INLINE rule1221 #-} + rule1221 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule1222 #-} + rule1222 = \ ((_expressionIself) :: Expression) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Expression_Lambda _rangeIself _patternsIself _expressionIself + {-# INLINE rule1223 #-} + rule1223 = \ _self -> + _self + {-# INLINE rule1224 #-} + rule1224 = \ _assumptions -> + _assumptions + {-# INLINE rule1225 #-} + rule1225 = \ _beta -> + _beta + {-# INLINE rule1226 #-} + rule1226 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule1227 #-} + rule1227 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule1228 #-} + rule1228 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule1229 #-} + rule1229 = \ _constraints -> + _constraints + {-# INLINE rule1230 #-} + rule1230 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1231 #-} + rule1231 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule1232 #-} + rule1232 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule1233 #-} + rule1233 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule1234 #-} + rule1234 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule1235 #-} + rule1235 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1236 #-} + rule1236 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1237 #-} + rule1237 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1238 #-} + rule1238 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1239 #-} + rule1239 = \ _parentTree -> + _parentTree + {-# INLINE rule1240 #-} + rule1240 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1241 #-} + rule1241 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1242 #-} + rule1242 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1243 #-} + rule1243 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1244 #-} + rule1244 = \ ((_patternsIbetaUnique) :: Int) -> + _patternsIbetaUnique + {-# INLINE rule1245 #-} + rule1245 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1246 #-} + rule1246 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1247 #-} + rule1247 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1248 #-} + rule1248 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule1249 #-} + rule1249 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1250 #-} + rule1250 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1251 #-} + rule1251 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1252 #-} + rule1252 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1253 #-} + rule1253 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1254 #-} + rule1254 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1255 #-} + rule1255 = \ _parentTree -> + _parentTree + {-# INLINE rule1256 #-} + rule1256 = \ ((_patternsIpatternMatchWarnings) :: [Warning]) -> + _patternsIpatternMatchWarnings + {-# INLINE rule1257 #-} + rule1257 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1258 #-} + rule1258 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1259 #-} + rule1259 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1260 #-} + rule1260 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Expression_Case #-} +sem_Expression_Case :: T_Range -> T_Expression -> T_Alternatives -> T_Expression +sem_Expression_Case arg_range_ arg_expression_ arg_alternatives_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _alternativesX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_alternatives_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + (T_Alternatives_vOut4 _alternativesIassumptions _alternativesIbetaUnique _alternativesIcollectErrors _alternativesIcollectInstances _alternativesIcollectWarnings _alternativesIconstraintslist _alternativesIcounter _alternativesIdictionaryEnvironment _alternativesIelementss _alternativesIinfoTrees _alternativesImatchIO _alternativesIpatternMatchWarnings _alternativesIself _alternativesIunboundNames _alternativesIuniqueChunk _alternativesIunrwars) = inv_Alternatives_s5 _alternativesX5 (T_Alternatives_vIn4 _alternativesOallPatterns _alternativesOallTypeSchemes _alternativesOavailablePredicates _alternativesObetaLeft _alternativesObetaRight _alternativesObetaUnique _alternativesOclassEnvironment _alternativesOcollectErrors _alternativesOcollectWarnings _alternativesOcounter _alternativesOcurrentChunk _alternativesOdictionaryEnvironment _alternativesOimportEnvironment _alternativesOmatchIO _alternativesOmonos _alternativesOnamesInScope _alternativesOorderedTypeSynonyms _alternativesOparentTree _alternativesOpatternMatchWarnings _alternativesOsubstitution _alternativesOtypeschemeMap _alternativesOuniqueChunk) + _expressionObetaUnique = rule1261 _lhsIbetaUnique + _alternativesObetaLeft = rule1262 _beta' + _alternativesObetaRight = rule1263 _beta + _assumptions = rule1264 _alternativesIassumptions _expressionIassumptions + _constraints = rule1265 _alternativesIconstraintslist _expressionIconstraints _newcon + _beta = rule1266 _lhsIbetaUnique + _beta' = rule1267 _lhsIbetaUnique + _newcon = rule1268 _beta' _cinfo _expressionIbeta + _cinfo = rule1269 _beta' _localInfo _parentTree + _localInfo = rule1270 _beta _lhsImonos _self + _parentTree = rule1271 _alternativesIinfoTrees _expressionIinfoTree _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1272 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOmatches = rule1273 _assumptions _constraints _lhsItryPatterns _localInfo + _expressionOtryPatterns = rule1274 () + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1275 _alternativesIelementss _alternativesIpatternMatchWarnings _alternativesIunrwars _expressionIbeta _lhsIimportEnvironment _lhsIsubstitution _rangeIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1276 _alternativesIcollectInstances _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1277 _alternativesIunboundNames _expressionIunboundNames + _self = rule1278 _alternativesIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1279 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule1280 _assumptions + _lhsObeta :: Tp + _lhsObeta = rule1281 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1282 _alternativesIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1283 _alternativesIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1284 _alternativesIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule1285 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule1286 _alternativesIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1287 _alternativesIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1288 _alternativesImatchIO + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1289 _alternativesIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule1290 _expressionIuniqueSecondRound + _expressionOallPatterns = rule1291 _lhsIallPatterns + _expressionOallTypeSchemes = rule1292 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule1293 _lhsIavailablePredicates + _expressionOclassEnvironment = rule1294 _lhsIclassEnvironment + _expressionOcollectErrors = rule1295 _lhsIcollectErrors + _expressionOcollectWarnings = rule1296 _lhsIcollectWarnings + _expressionOcounter = rule1297 _lhsIcounter + _expressionOcurrentChunk = rule1298 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule1299 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule1300 _lhsIimportEnvironment + _expressionOmatchIO = rule1301 _lhsImatchIO + _expressionOmonos = rule1302 _lhsImonos + _expressionOnamesInScope = rule1303 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule1304 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule1305 _parentTree + _expressionOpatternMatchWarnings = rule1306 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule1307 _lhsIsubstitution + _expressionOtypeschemeMap = rule1308 _lhsItypeschemeMap + _expressionOuniqueChunk = rule1309 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule1310 _lhsIuniqueSecondRound + _alternativesOallPatterns = rule1311 _lhsIallPatterns + _alternativesOallTypeSchemes = rule1312 _lhsIallTypeSchemes + _alternativesOavailablePredicates = rule1313 _lhsIavailablePredicates + _alternativesObetaUnique = rule1314 _expressionIbetaUnique + _alternativesOclassEnvironment = rule1315 _lhsIclassEnvironment + _alternativesOcollectErrors = rule1316 _expressionIcollectErrors + _alternativesOcollectWarnings = rule1317 _expressionIcollectWarnings + _alternativesOcounter = rule1318 _expressionIcounter + _alternativesOcurrentChunk = rule1319 _lhsIcurrentChunk + _alternativesOdictionaryEnvironment = rule1320 _expressionIdictionaryEnvironment + _alternativesOimportEnvironment = rule1321 _lhsIimportEnvironment + _alternativesOmatchIO = rule1322 _expressionImatchIO + _alternativesOmonos = rule1323 _lhsImonos + _alternativesOnamesInScope = rule1324 _lhsInamesInScope + _alternativesOorderedTypeSynonyms = rule1325 _lhsIorderedTypeSynonyms + _alternativesOparentTree = rule1326 _parentTree + _alternativesOpatternMatchWarnings = rule1327 _expressionIpatternMatchWarnings + _alternativesOsubstitution = rule1328 _lhsIsubstitution + _alternativesOtypeschemeMap = rule1329 _lhsItypeschemeMap + _alternativesOuniqueChunk = rule1330 _expressionIuniqueChunk + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1261 #-} + rule1261 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 2 + {-# INLINE rule1262 #-} + rule1262 = \ _beta' -> + _beta' + {-# INLINE rule1263 #-} + rule1263 = \ _beta -> + _beta + {-# INLINE rule1264 #-} + rule1264 = \ ((_alternativesIassumptions) :: Assumptions) ((_expressionIassumptions) :: Assumptions) -> + _expressionIassumptions `combine` _alternativesIassumptions + {-# INLINE rule1265 #-} + rule1265 = \ ((_alternativesIconstraintslist) :: ConstraintSets) ((_expressionIconstraints) :: ConstraintSet) _newcon -> + Node [ _newcon .<. _expressionIconstraints + , Node _alternativesIconstraintslist + ] + {-# INLINE rule1266 #-} + rule1266 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1267 #-} + rule1267 = \ ((_lhsIbetaUnique) :: Int) -> + TVar (_lhsIbetaUnique + 1) + {-# INLINE rule1268 #-} + rule1268 = \ _beta' _cinfo ((_expressionIbeta) :: Tp) -> + [ (_expressionIbeta .==. _beta') _cinfo ] + {-# INLINE rule1269 #-} + rule1269 = \ _beta' _localInfo _parentTree -> + childConstraint 0 "scrutinee of case expression" _parentTree + [ Unifier (head (ftv _beta')) ("case patterns", _localInfo, "scrutinee") ] + {-# INLINE rule1270 #-} + rule1270 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1271 #-} + rule1271 = \ ((_alternativesIinfoTrees) :: InfoTrees) ((_expressionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo (_expressionIinfoTree : _alternativesIinfoTrees) + {-# INLINE rule1272 #-} + rule1272 = \ _parentTree -> + _parentTree + {-# INLINE rule1273 #-} + rule1273 = \ _assumptions _constraints ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in matchOnlyVariable infoTuple _lhsItryPatterns + {-# INLINE rule1274 #-} + rule1274 = \ (_ :: ()) -> + [] + {-# INLINE rule1275 #-} + rule1275 = \ ((_alternativesIelementss) :: [([PatternElement], Bool)]) ((_alternativesIpatternMatchWarnings) :: [Warning]) ((_alternativesIunrwars) :: [Warning]) ((_expressionIbeta) :: Tp) ((_lhsIimportEnvironment) :: ImportEnvironment) ((_lhsIsubstitution) :: FixpointSubstitution) ((_rangeIself) :: Range) -> + patternMatchWarnings _lhsIimportEnvironment + _lhsIsubstitution + _expressionIbeta + (:[]) + _alternativesIelementss + _rangeIself + Nothing + False + _alternativesIunrwars + "case expression" + "->" + ++ _alternativesIpatternMatchWarnings + {-# INLINE rule1276 #-} + rule1276 = \ ((_alternativesIcollectInstances) :: [(Name, Instance)]) ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances ++ _alternativesIcollectInstances + {-# INLINE rule1277 #-} + rule1277 = \ ((_alternativesIunboundNames) :: Names) ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames ++ _alternativesIunboundNames + {-# INLINE rule1278 #-} + rule1278 = \ ((_alternativesIself) :: Alternatives) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Case _rangeIself _expressionIself _alternativesIself + {-# INLINE rule1279 #-} + rule1279 = \ _self -> + _self + {-# INLINE rule1280 #-} + rule1280 = \ _assumptions -> + _assumptions + {-# INLINE rule1281 #-} + rule1281 = \ _beta -> + _beta + {-# INLINE rule1282 #-} + rule1282 = \ ((_alternativesIbetaUnique) :: Int) -> + _alternativesIbetaUnique + {-# INLINE rule1283 #-} + rule1283 = \ ((_alternativesIcollectErrors) :: TypeErrors) -> + _alternativesIcollectErrors + {-# INLINE rule1284 #-} + rule1284 = \ ((_alternativesIcollectWarnings) :: Warnings) -> + _alternativesIcollectWarnings + {-# INLINE rule1285 #-} + rule1285 = \ _constraints -> + _constraints + {-# INLINE rule1286 #-} + rule1286 = \ ((_alternativesIcounter) :: Int) -> + _alternativesIcounter + {-# INLINE rule1287 #-} + rule1287 = \ ((_alternativesIdictionaryEnvironment) :: DictionaryEnvironment) -> + _alternativesIdictionaryEnvironment + {-# INLINE rule1288 #-} + rule1288 = \ ((_alternativesImatchIO) :: IO ()) -> + _alternativesImatchIO + {-# INLINE rule1289 #-} + rule1289 = \ ((_alternativesIuniqueChunk) :: Int) -> + _alternativesIuniqueChunk + {-# INLINE rule1290 #-} + rule1290 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule1291 #-} + rule1291 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1292 #-} + rule1292 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1293 #-} + rule1293 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1294 #-} + rule1294 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1295 #-} + rule1295 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1296 #-} + rule1296 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1297 #-} + rule1297 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1298 #-} + rule1298 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1299 #-} + rule1299 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1300 #-} + rule1300 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1301 #-} + rule1301 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1302 #-} + rule1302 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1303 #-} + rule1303 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1304 #-} + rule1304 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1305 #-} + rule1305 = \ _parentTree -> + _parentTree + {-# INLINE rule1306 #-} + rule1306 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1307 #-} + rule1307 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1308 #-} + rule1308 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1309 #-} + rule1309 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1310 #-} + rule1310 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule1311 #-} + rule1311 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1312 #-} + rule1312 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1313 #-} + rule1313 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1314 #-} + rule1314 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule1315 #-} + rule1315 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1316 #-} + rule1316 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule1317 #-} + rule1317 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule1318 #-} + rule1318 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1319 #-} + rule1319 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1320 #-} + rule1320 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule1321 #-} + rule1321 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1322 #-} + rule1322 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule1323 #-} + rule1323 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1324 #-} + rule1324 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1325 #-} + rule1325 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1326 #-} + rule1326 = \ _parentTree -> + _parentTree + {-# INLINE rule1327 #-} + rule1327 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule1328 #-} + rule1328 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1329 #-} + rule1329 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1330 #-} + rule1330 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk +{-# NOINLINE sem_Expression_Let #-} +sem_Expression_Let :: T_Range -> T_Declarations -> T_Expression -> T_Expression +sem_Expression_Let arg_range_ arg_declarations_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIbetaUnique _declarationsIbindingGroups _declarationsIcollectErrors _declarationsIcollectInstances _declarationsIcollectWarnings _declarationsIcounter _declarationsIdeclVarNames _declarationsIdictionaryEnvironment _declarationsIinfoTrees _declarationsImatchIO _declarationsIpatternMatchWarnings _declarationsIrestrictedNames _declarationsIself _declarationsIsimplePatNames _declarationsItypeSignatures _declarationsIunboundNames _declarationsIuniqueChunk) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOallPatterns _declarationsOallTypeSchemes _declarationsOavailablePredicates _declarationsObetaUnique _declarationsObindingGroups _declarationsOclassEnvironment _declarationsOcollectErrors _declarationsOcollectWarnings _declarationsOcounter _declarationsOcurrentChunk _declarationsOdictionaryEnvironment _declarationsOimportEnvironment _declarationsOinheritedBDG _declarationsOmatchIO _declarationsOmonos _declarationsOnamesInScope _declarationsOorderedTypeSynonyms _declarationsOparentTree _declarationsOpatternMatchWarnings _declarationsOsubstitution _declarationsOtypeSignatures _declarationsOtypeschemeMap _declarationsOuniqueChunk) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _declarationsObetaUnique = rule1331 _lhsIbetaUnique + _declarationsObindingGroups = rule1332 () + _constraints = rule1333 _beta _cinfoType _cset _expressionIbeta + _beta = rule1334 _lhsIbetaUnique + _lhsObetaUnique :: Int + (_assumptions,_cset,_inheritedBDG,_chunkNr,_lhsObetaUnique,_implicitsFM) = rule1335 _declarationsIbindingGroups _declarationsItypeSignatures _expressionIassumptions _expressionIbetaUnique _expressionIconstraints _expressionIuniqueChunk _lhsIcurrentChunk _lhsImonos + _inferredTypes = rule1336 _implicitsFM _lhsItypeschemeMap + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1337 _declarationsIsimplePatNames _expressionIcollectWarnings _inferredTypes + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1338 _declarationsIcollectErrors _declarationsIrestrictedNames _inferredTypes + _allTypeSchemes = rule1339 _lhsIallTypeSchemes _localTypes + _localTypes = rule1340 _declarationsIbindingGroups _declarationsItypeSignatures _inferredTypes + _declarationsOtypeSignatures = rule1341 () + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1342 _chunkNr + _cinfoType = rule1343 _thisTree + _localInfo = rule1344 _beta _lhsImonos _self + _declInfo = rule1345 _declarationsIself _lhsImonos + _thisTree = rule1346 _declTree _expressionIinfoTree _lhsIparentTree _localInfo + _declTree = rule1347 _declInfo _declarationsIinfoTrees _thisTree + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1348 _thisTree + _expressionOparentTree = rule1349 _thisTree + _declarationsOparentTree = rule1350 _declTree + (_collectTypeConstructors,_collectValueConstructors,_collectTypeSynonyms,_collectConstructorEnv,_derivedFunctions,_operatorFixities) = rule1351 () + (_namesInScope,_unboundNames,_scopeInfo) = rule1352 _declarationsIdeclVarNames _declarationsIunboundNames _expressionIunboundNames _lhsInamesInScope + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1353 _unboundNames + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOmatches = rule1354 _assumptions _constraints _lhsItryPatterns _localInfo + _expressionOtryPatterns = rule1355 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1356 _declarationsIcollectInstances _expressionIcollectInstances + _self = rule1357 _declarationsIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1358 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule1359 _assumptions + _lhsObeta :: Tp + _lhsObeta = rule1360 _beta + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule1361 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule1362 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1363 _expressionIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1364 _expressionImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1365 _expressionIpatternMatchWarnings + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule1366 _expressionIuniqueSecondRound + _declarationsOallPatterns = rule1367 _lhsIallPatterns + _declarationsOallTypeSchemes = rule1368 _allTypeSchemes + _declarationsOavailablePredicates = rule1369 _lhsIavailablePredicates + _declarationsOclassEnvironment = rule1370 _lhsIclassEnvironment + _declarationsOcollectErrors = rule1371 _lhsIcollectErrors + _declarationsOcollectWarnings = rule1372 _lhsIcollectWarnings + _declarationsOcounter = rule1373 _lhsIcounter + _declarationsOcurrentChunk = rule1374 _lhsIcurrentChunk + _declarationsOdictionaryEnvironment = rule1375 _lhsIdictionaryEnvironment + _declarationsOimportEnvironment = rule1376 _lhsIimportEnvironment + _declarationsOinheritedBDG = rule1377 _inheritedBDG + _declarationsOmatchIO = rule1378 _lhsImatchIO + _declarationsOmonos = rule1379 _lhsImonos + _declarationsOnamesInScope = rule1380 _namesInScope + _declarationsOorderedTypeSynonyms = rule1381 _lhsIorderedTypeSynonyms + _declarationsOpatternMatchWarnings = rule1382 _lhsIpatternMatchWarnings + _declarationsOsubstitution = rule1383 _lhsIsubstitution + _declarationsOtypeschemeMap = rule1384 _lhsItypeschemeMap + _declarationsOuniqueChunk = rule1385 _lhsIuniqueChunk + _expressionOallPatterns = rule1386 _lhsIallPatterns + _expressionOallTypeSchemes = rule1387 _allTypeSchemes + _expressionOavailablePredicates = rule1388 _lhsIavailablePredicates + _expressionObetaUnique = rule1389 _declarationsIbetaUnique + _expressionOclassEnvironment = rule1390 _lhsIclassEnvironment + _expressionOcollectErrors = rule1391 _declarationsIcollectErrors + _expressionOcollectWarnings = rule1392 _declarationsIcollectWarnings + _expressionOcounter = rule1393 _declarationsIcounter + _expressionOcurrentChunk = rule1394 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule1395 _declarationsIdictionaryEnvironment + _expressionOimportEnvironment = rule1396 _lhsIimportEnvironment + _expressionOmatchIO = rule1397 _declarationsImatchIO + _expressionOmonos = rule1398 _lhsImonos + _expressionOnamesInScope = rule1399 _namesInScope + _expressionOorderedTypeSynonyms = rule1400 _lhsIorderedTypeSynonyms + _expressionOpatternMatchWarnings = rule1401 _declarationsIpatternMatchWarnings + _expressionOsubstitution = rule1402 _lhsIsubstitution + _expressionOtypeschemeMap = rule1403 _lhsItypeschemeMap + _expressionOuniqueChunk = rule1404 _declarationsIuniqueChunk + _expressionOuniqueSecondRound = rule1405 _lhsIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1331 #-} + rule1331 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule1332 #-} + rule1332 = \ (_ :: ()) -> + [] + {-# INLINE rule1333 #-} + rule1333 = \ _beta _cinfoType _cset ((_expressionIbeta) :: Tp) -> + [ (_expressionIbeta .==. _beta) _cinfoType ] .>. _cset + {-# INLINE rule1334 #-} + rule1334 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1335 #-} + rule1335 = \ ((_declarationsIbindingGroups) :: BindingGroups) ((_declarationsItypeSignatures) :: TypeEnvironment) ((_expressionIassumptions) :: Assumptions) ((_expressionIbetaUnique) :: Int) ((_expressionIconstraints) :: ConstraintSet) ((_expressionIuniqueChunk) :: Int) ((_lhsIcurrentChunk) :: Int) ((_lhsImonos) :: Monos) -> + let inputBDG = (False, _lhsIcurrentChunk, _expressionIuniqueChunk, _lhsImonos, _declarationsItypeSignatures, mybdggroup, _expressionIbetaUnique) + mybdggroup = Just (_expressionIassumptions, [_expressionIconstraints]) + in performBindingGroup inputBDG _declarationsIbindingGroups + {-# INLINE rule1336 #-} + rule1336 = \ _implicitsFM ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + findInferredTypes _lhsItypeschemeMap _implicitsFM + {-# INLINE rule1337 #-} + rule1337 = \ ((_declarationsIsimplePatNames) :: Names) ((_expressionIcollectWarnings) :: Warnings) _inferredTypes -> + missingTypeSignature False _declarationsIsimplePatNames _inferredTypes + ++ _expressionIcollectWarnings + {-# INLINE rule1338 #-} + rule1338 = \ ((_declarationsIcollectErrors) :: TypeErrors) ((_declarationsIrestrictedNames) :: Names) _inferredTypes -> + restrictedNameErrors _inferredTypes _declarationsIrestrictedNames + ++ _declarationsIcollectErrors + {-# INLINE rule1339 #-} + rule1339 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) _localTypes -> + _localTypes `M.union` _lhsIallTypeSchemes + {-# INLINE rule1340 #-} + rule1340 = \ ((_declarationsIbindingGroups) :: BindingGroups) ((_declarationsItypeSignatures) :: TypeEnvironment) _inferredTypes -> + makeLocalTypeEnv (_declarationsItypeSignatures `M.union` _inferredTypes) _declarationsIbindingGroups + {-# INLINE rule1341 #-} + rule1341 = \ (_ :: ()) -> + M.empty + {-# INLINE rule1342 #-} + rule1342 = \ _chunkNr -> + _chunkNr + {-# INLINE rule1343 #-} + rule1343 = \ _thisTree -> + resultConstraint "let expression (INTERNAL ERROR)" _thisTree + [ FolkloreConstraint, highlyTrusted ] + {-# INLINE rule1344 #-} + rule1344 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1345 #-} + rule1345 = \ ((_declarationsIself) :: Declarations) ((_lhsImonos) :: Monos) -> + LocalInfo { self = UHA_Decls _declarationsIself + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule1346 #-} + rule1346 = \ _declTree ((_expressionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [_declTree, _expressionIinfoTree] + {-# INLINE rule1347 #-} + rule1347 = \ _declInfo ((_declarationsIinfoTrees) :: InfoTrees) _thisTree -> + node _thisTree _declInfo _declarationsIinfoTrees + {-# INLINE rule1348 #-} + rule1348 = \ _thisTree -> + _thisTree + {-# INLINE rule1349 #-} + rule1349 = \ _thisTree -> + _thisTree + {-# INLINE rule1350 #-} + rule1350 = \ _declTree -> + _declTree + {-# INLINE rule1351 #-} + rule1351 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "toplevel Expression" + {-# INLINE rule1352 #-} + rule1352 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIunboundNames) :: Names) ((_expressionIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) -> + changeOfScope _declarationsIdeclVarNames (_declarationsIunboundNames ++ _expressionIunboundNames) _lhsInamesInScope + {-# INLINE rule1353 #-} + rule1353 = \ _unboundNames -> + _unboundNames + {-# INLINE rule1354 #-} + rule1354 = \ _assumptions _constraints ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in matchOnlyVariable infoTuple _lhsItryPatterns + {-# INLINE rule1355 #-} + rule1355 = \ (_ :: ()) -> + [] + {-# INLINE rule1356 #-} + rule1356 = \ ((_declarationsIcollectInstances) :: [(Name, Instance)]) ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _declarationsIcollectInstances ++ _expressionIcollectInstances + {-# INLINE rule1357 #-} + rule1357 = \ ((_declarationsIself) :: Declarations) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Let _rangeIself _declarationsIself _expressionIself + {-# INLINE rule1358 #-} + rule1358 = \ _self -> + _self + {-# INLINE rule1359 #-} + rule1359 = \ _assumptions -> + _assumptions + {-# INLINE rule1360 #-} + rule1360 = \ _beta -> + _beta + {-# INLINE rule1361 #-} + rule1361 = \ _constraints -> + _constraints + {-# INLINE rule1362 #-} + rule1362 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1363 #-} + rule1363 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule1364 #-} + rule1364 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule1365 #-} + rule1365 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule1366 #-} + rule1366 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule1367 #-} + rule1367 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1368 #-} + rule1368 = \ _allTypeSchemes -> + _allTypeSchemes + {-# INLINE rule1369 #-} + rule1369 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1370 #-} + rule1370 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1371 #-} + rule1371 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1372 #-} + rule1372 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1373 #-} + rule1373 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1374 #-} + rule1374 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1375 #-} + rule1375 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1376 #-} + rule1376 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1377 #-} + rule1377 = \ _inheritedBDG -> + _inheritedBDG + {-# INLINE rule1378 #-} + rule1378 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1379 #-} + rule1379 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1380 #-} + rule1380 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1381 #-} + rule1381 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1382 #-} + rule1382 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1383 #-} + rule1383 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1384 #-} + rule1384 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1385 #-} + rule1385 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1386 #-} + rule1386 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1387 #-} + rule1387 = \ _allTypeSchemes -> + _allTypeSchemes + {-# INLINE rule1388 #-} + rule1388 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1389 #-} + rule1389 = \ ((_declarationsIbetaUnique) :: Int) -> + _declarationsIbetaUnique + {-# INLINE rule1390 #-} + rule1390 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1391 #-} + rule1391 = \ ((_declarationsIcollectErrors) :: TypeErrors) -> + _declarationsIcollectErrors + {-# INLINE rule1392 #-} + rule1392 = \ ((_declarationsIcollectWarnings) :: Warnings) -> + _declarationsIcollectWarnings + {-# INLINE rule1393 #-} + rule1393 = \ ((_declarationsIcounter) :: Int) -> + _declarationsIcounter + {-# INLINE rule1394 #-} + rule1394 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1395 #-} + rule1395 = \ ((_declarationsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _declarationsIdictionaryEnvironment + {-# INLINE rule1396 #-} + rule1396 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1397 #-} + rule1397 = \ ((_declarationsImatchIO) :: IO ()) -> + _declarationsImatchIO + {-# INLINE rule1398 #-} + rule1398 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1399 #-} + rule1399 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1400 #-} + rule1400 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1401 #-} + rule1401 = \ ((_declarationsIpatternMatchWarnings) :: [Warning]) -> + _declarationsIpatternMatchWarnings + {-# INLINE rule1402 #-} + rule1402 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1403 #-} + rule1403 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1404 #-} + rule1404 = \ ((_declarationsIuniqueChunk) :: Int) -> + _declarationsIuniqueChunk + {-# INLINE rule1405 #-} + rule1405 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Expression_Do #-} +sem_Expression_Do :: T_Range -> T_Statements -> T_Expression +sem_Expression_Do arg_range_ arg_statements_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _statementsX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_statements_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Statements_vOut157 _statementsIassumptions _statementsIbetaUnique _statementsIcollectErrors _statementsIcollectInstances _statementsIcollectWarnings _statementsIconstraints _statementsIcounter _statementsIdictionaryEnvironment _statementsIgeneratorBeta _statementsIinfoTrees _statementsImatchIO _statementsInamesInScope _statementsIpatternMatchWarnings _statementsIself _statementsIunboundNames _statementsIuniqueChunk _statementsIuniqueSecondRound) = inv_Statements_s158 _statementsX158 (T_Statements_vIn157 _statementsOallPatterns _statementsOallTypeSchemes _statementsOassumptions _statementsOavailablePredicates _statementsObetaUnique _statementsOclassEnvironment _statementsOcollectErrors _statementsOcollectWarnings _statementsOconstraints _statementsOcounter _statementsOcurrentChunk _statementsOdictionaryEnvironment _statementsOgeneratorBeta _statementsOimportEnvironment _statementsOmatchIO _statementsOmonos _statementsOnamesInScope _statementsOorderedTypeSynonyms _statementsOparentTree _statementsOpatternMatchWarnings _statementsOsubstitution _statementsOtypeschemeMap _statementsOunboundNames _statementsOuniqueChunk _statementsOuniqueSecondRound) + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule1406 _newcon _statementsIconstraints + _statementsObetaUnique = rule1407 _lhsIbetaUnique + _statementsOgeneratorBeta = rule1408 () + _statementsOassumptions = rule1409 () + _assumptions = rule1410 _statementsIassumptions + _constraints = rule1411 () + _beta = rule1412 _lhsIbetaUnique + _newcon = rule1413 _beta _cinfo _statementsIgeneratorBeta + _cinfo = rule1414 _parentTree + _localInfo = rule1415 _beta _lhsImonos _self + _parentTree = rule1416 _lhsIparentTree _localInfo _statementsIinfoTrees + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1417 _parentTree + _statementsOunboundNames = rule1418 () + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOmatches = rule1419 _assumptions _constraints _lhsItryPatterns _localInfo + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1420 _statementsIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1421 _statementsIunboundNames + _self = rule1422 _rangeIself _statementsIself + _lhsOself :: Expression + _lhsOself = rule1423 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule1424 _assumptions + _lhsObeta :: Tp + _lhsObeta = rule1425 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1426 _statementsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1427 _statementsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1428 _statementsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule1429 _statementsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1430 _statementsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1431 _statementsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1432 _statementsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1433 _statementsIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule1434 _statementsIuniqueSecondRound + _statementsOallPatterns = rule1435 _lhsIallPatterns + _statementsOallTypeSchemes = rule1436 _lhsIallTypeSchemes + _statementsOavailablePredicates = rule1437 _lhsIavailablePredicates + _statementsOclassEnvironment = rule1438 _lhsIclassEnvironment + _statementsOcollectErrors = rule1439 _lhsIcollectErrors + _statementsOcollectWarnings = rule1440 _lhsIcollectWarnings + _statementsOconstraints = rule1441 _constraints + _statementsOcounter = rule1442 _lhsIcounter + _statementsOcurrentChunk = rule1443 _lhsIcurrentChunk + _statementsOdictionaryEnvironment = rule1444 _lhsIdictionaryEnvironment + _statementsOimportEnvironment = rule1445 _lhsIimportEnvironment + _statementsOmatchIO = rule1446 _lhsImatchIO + _statementsOmonos = rule1447 _lhsImonos + _statementsOnamesInScope = rule1448 _lhsInamesInScope + _statementsOorderedTypeSynonyms = rule1449 _lhsIorderedTypeSynonyms + _statementsOparentTree = rule1450 _parentTree + _statementsOpatternMatchWarnings = rule1451 _lhsIpatternMatchWarnings + _statementsOsubstitution = rule1452 _lhsIsubstitution + _statementsOtypeschemeMap = rule1453 _lhsItypeschemeMap + _statementsOuniqueChunk = rule1454 _lhsIuniqueChunk + _statementsOuniqueSecondRound = rule1455 _lhsIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1406 #-} + rule1406 = \ _newcon ((_statementsIconstraints) :: ConstraintSet) -> + Node [ _newcon .<. _statementsIconstraints ] + {-# INLINE rule1407 #-} + rule1407 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule1408 #-} + rule1408 = \ (_ :: ()) -> + Nothing + {-# INLINE rule1409 #-} + rule1409 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule1410 #-} + rule1410 = \ ((_statementsIassumptions) :: Assumptions) -> + _statementsIassumptions + {-# INLINE rule1411 #-} + rule1411 = \ (_ :: ()) -> + emptyTree + {-# INLINE rule1412 #-} + rule1412 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1413 #-} + rule1413 = \ _beta _cinfo ((_statementsIgeneratorBeta) :: Maybe Tp) -> + case _statementsIgeneratorBeta of + Nothing -> [] + Just b -> [ (ioType b .==. _beta) _cinfo ] + {-# INLINE rule1414 #-} + rule1414 = \ _parentTree -> + resultConstraint "do-expression" _parentTree + [ FolkloreConstraint ] + {-# INLINE rule1415 #-} + rule1415 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1416 #-} + rule1416 = \ ((_lhsIparentTree) :: InfoTree) _localInfo ((_statementsIinfoTrees) :: InfoTrees) -> + node _lhsIparentTree _localInfo _statementsIinfoTrees + {-# INLINE rule1417 #-} + rule1417 = \ _parentTree -> + _parentTree + {-# INLINE rule1418 #-} + rule1418 = \ (_ :: ()) -> + [] + {-# INLINE rule1419 #-} + rule1419 = \ _assumptions _constraints ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in matchOnlyVariable infoTuple _lhsItryPatterns + {-# INLINE rule1420 #-} + rule1420 = \ ((_statementsIcollectInstances) :: [(Name, Instance)]) -> + _statementsIcollectInstances + {-# INLINE rule1421 #-} + rule1421 = \ ((_statementsIunboundNames) :: Names) -> + _statementsIunboundNames + {-# INLINE rule1422 #-} + rule1422 = \ ((_rangeIself) :: Range) ((_statementsIself) :: Statements) -> + Expression_Do _rangeIself _statementsIself + {-# INLINE rule1423 #-} + rule1423 = \ _self -> + _self + {-# INLINE rule1424 #-} + rule1424 = \ _assumptions -> + _assumptions + {-# INLINE rule1425 #-} + rule1425 = \ _beta -> + _beta + {-# INLINE rule1426 #-} + rule1426 = \ ((_statementsIbetaUnique) :: Int) -> + _statementsIbetaUnique + {-# INLINE rule1427 #-} + rule1427 = \ ((_statementsIcollectErrors) :: TypeErrors) -> + _statementsIcollectErrors + {-# INLINE rule1428 #-} + rule1428 = \ ((_statementsIcollectWarnings) :: Warnings) -> + _statementsIcollectWarnings + {-# INLINE rule1429 #-} + rule1429 = \ ((_statementsIcounter) :: Int) -> + _statementsIcounter + {-# INLINE rule1430 #-} + rule1430 = \ ((_statementsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _statementsIdictionaryEnvironment + {-# INLINE rule1431 #-} + rule1431 = \ ((_statementsImatchIO) :: IO ()) -> + _statementsImatchIO + {-# INLINE rule1432 #-} + rule1432 = \ ((_statementsIpatternMatchWarnings) :: [Warning]) -> + _statementsIpatternMatchWarnings + {-# INLINE rule1433 #-} + rule1433 = \ ((_statementsIuniqueChunk) :: Int) -> + _statementsIuniqueChunk + {-# INLINE rule1434 #-} + rule1434 = \ ((_statementsIuniqueSecondRound) :: Int) -> + _statementsIuniqueSecondRound + {-# INLINE rule1435 #-} + rule1435 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1436 #-} + rule1436 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1437 #-} + rule1437 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1438 #-} + rule1438 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1439 #-} + rule1439 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1440 #-} + rule1440 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1441 #-} + rule1441 = \ _constraints -> + _constraints + {-# INLINE rule1442 #-} + rule1442 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1443 #-} + rule1443 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1444 #-} + rule1444 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1445 #-} + rule1445 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1446 #-} + rule1446 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1447 #-} + rule1447 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1448 #-} + rule1448 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1449 #-} + rule1449 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1450 #-} + rule1450 = \ _parentTree -> + _parentTree + {-# INLINE rule1451 #-} + rule1451 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1452 #-} + rule1452 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1453 #-} + rule1453 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1454 #-} + rule1454 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1455 #-} + rule1455 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Expression_List #-} +sem_Expression_List :: T_Range -> T_Expressions -> T_Expression +sem_Expression_List arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIassumptions _expressionsIbetaUnique _expressionsIbetas _expressionsIcollectErrors _expressionsIcollectInstances _expressionsIcollectWarnings _expressionsIconstraintslist _expressionsIcounter _expressionsIdictionaryEnvironment _expressionsIinfoTrees _expressionsImatchIO _expressionsImatches _expressionsIpatternMatchWarnings _expressionsIself _expressionsIunboundNames _expressionsIuniqueChunk _expressionsIuniqueSecondRound) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 _expressionsOallPatterns _expressionsOallTypeSchemes _expressionsOavailablePredicates _expressionsObetaUnique _expressionsOclassEnvironment _expressionsOcollectErrors _expressionsOcollectWarnings _expressionsOcounter _expressionsOcurrentChunk _expressionsOdictionaryEnvironment _expressionsOimportEnvironment _expressionsOmatchIO _expressionsOmonos _expressionsOnamesInScope _expressionsOorderedTypeSynonyms _expressionsOparentTree _expressionsOpatternMatchWarnings _expressionsOsubstitution _expressionsOtryPatterns _expressionsOtypeschemeMap _expressionsOuniqueChunk _expressionsOuniqueSecondRound) + _expressionsObetaUnique = rule1456 _lhsIbetaUnique + _constraints = rule1457 _expressionsIbetas _expressionsIconstraintslist _newcon _zipf + _beta = rule1458 _lhsIbetaUnique + _beta' = rule1459 _lhsIbetaUnique + _newcon = rule1460 _beta _beta' _cinfoResult + _zipf = rule1461 _beta' _cinfoElem + _cinfoElem = rule1462 _beta' _expressionsIbetas _localInfo _parentTree + _cinfoResult = rule1463 _parentTree + _localInfo = rule1464 _beta _lhsImonos _self + _parentTree = rule1465 _expressionsIinfoTrees _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1466 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + (_expressionsOtryPatterns,_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule1467 _constraints _expressionsIassumptions _expressionsImatches _expressionsIuniqueSecondRound _lhsIallPatterns _lhsItryPatterns _localInfo + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1468 _expressionsImatchIO _ioMatch + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1469 _expressionsIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1470 _expressionsIunboundNames + _self = rule1471 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1472 _self + _lhsObeta :: Tp + _lhsObeta = rule1473 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1474 _expressionsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1475 _expressionsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1476 _expressionsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule1477 _expressionsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1478 _expressionsIdictionaryEnvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1479 _expressionsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1480 _expressionsIuniqueChunk + _expressionsOallPatterns = rule1481 _lhsIallPatterns + _expressionsOallTypeSchemes = rule1482 _lhsIallTypeSchemes + _expressionsOavailablePredicates = rule1483 _lhsIavailablePredicates + _expressionsOclassEnvironment = rule1484 _lhsIclassEnvironment + _expressionsOcollectErrors = rule1485 _lhsIcollectErrors + _expressionsOcollectWarnings = rule1486 _lhsIcollectWarnings + _expressionsOcounter = rule1487 _lhsIcounter + _expressionsOcurrentChunk = rule1488 _lhsIcurrentChunk + _expressionsOdictionaryEnvironment = rule1489 _lhsIdictionaryEnvironment + _expressionsOimportEnvironment = rule1490 _lhsIimportEnvironment + _expressionsOmatchIO = rule1491 _lhsImatchIO + _expressionsOmonos = rule1492 _lhsImonos + _expressionsOnamesInScope = rule1493 _lhsInamesInScope + _expressionsOorderedTypeSynonyms = rule1494 _lhsIorderedTypeSynonyms + _expressionsOparentTree = rule1495 _parentTree + _expressionsOpatternMatchWarnings = rule1496 _lhsIpatternMatchWarnings + _expressionsOsubstitution = rule1497 _lhsIsubstitution + _expressionsOtypeschemeMap = rule1498 _lhsItypeschemeMap + _expressionsOuniqueChunk = rule1499 _lhsIuniqueChunk + _expressionsOuniqueSecondRound = rule1500 _lhsIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1456 #-} + rule1456 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 2 + {-# INLINE rule1457 #-} + rule1457 = \ ((_expressionsIbetas) :: Tps) ((_expressionsIconstraintslist) :: ConstraintSets) _newcon _zipf -> + _newcon .>. + Node (zipWith3 _zipf _expressionsIbetas [0..] _expressionsIconstraintslist) + {-# INLINE rule1458 #-} + rule1458 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1459 #-} + rule1459 = \ ((_lhsIbetaUnique) :: Int) -> + TVar (_lhsIbetaUnique + 1) + {-# INLINE rule1460 #-} + rule1460 = \ _beta _beta' _cinfoResult -> + [ (listType _beta' .==. _beta) _cinfoResult ] + {-# INLINE rule1461 #-} + rule1461 = \ _beta' _cinfoElem -> + \tp childNr ctree -> [ (tp .==. _beta') (_cinfoElem childNr) ] .<. ctree + {-# INLINE rule1462 #-} + rule1462 = \ _beta' ((_expressionsIbetas) :: Tps) _localInfo _parentTree -> + \elemNr -> + childConstraint elemNr "element of list" _parentTree $ + [ HasTrustFactor 10.0 | length _expressionsIbetas < 2 ] ++ + [ Unifier (head (ftv _beta')) ("list", _localInfo, ordinal False (elemNr+1) ++ " element") ] + {-# INLINE rule1463 #-} + rule1463 = \ _parentTree -> + resultConstraint "list" _parentTree + [ FolkloreConstraint ] + {-# INLINE rule1464 #-} + rule1464 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1465 #-} + rule1465 = \ ((_expressionsIinfoTrees) :: InfoTrees) ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo (_expressionsIinfoTrees) + {-# INLINE rule1466 #-} + rule1466 = \ _parentTree -> + _parentTree + {-# INLINE rule1467 #-} + rule1467 = \ _constraints ((_expressionsIassumptions) :: Assumptions) ((_expressionsImatches) :: [Maybe MetaVariableTable]) ((_expressionsIuniqueSecondRound) :: Int) ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo -> + let infoTuple = metaVarInfo _constraints _expressionsIassumptions _localInfo + in match1 infoTuple _expressionsIuniqueSecondRound + match_Expression_List + _lhsItryPatterns _lhsIallPatterns + [_expressionsImatches] + {-# INLINE rule1468 #-} + rule1468 = \ ((_expressionsImatchIO) :: IO ()) _ioMatch -> + _expressionsImatchIO >> _ioMatch + {-# INLINE rule1469 #-} + rule1469 = \ ((_expressionsIcollectInstances) :: [(Name, Instance)]) -> + _expressionsIcollectInstances + {-# INLINE rule1470 #-} + rule1470 = \ ((_expressionsIunboundNames) :: Names) -> + _expressionsIunboundNames + {-# INLINE rule1471 #-} + rule1471 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_List _rangeIself _expressionsIself + {-# INLINE rule1472 #-} + rule1472 = \ _self -> + _self + {-# INLINE rule1473 #-} + rule1473 = \ _beta -> + _beta + {-# INLINE rule1474 #-} + rule1474 = \ ((_expressionsIbetaUnique) :: Int) -> + _expressionsIbetaUnique + {-# INLINE rule1475 #-} + rule1475 = \ ((_expressionsIcollectErrors) :: TypeErrors) -> + _expressionsIcollectErrors + {-# INLINE rule1476 #-} + rule1476 = \ ((_expressionsIcollectWarnings) :: Warnings) -> + _expressionsIcollectWarnings + {-# INLINE rule1477 #-} + rule1477 = \ ((_expressionsIcounter) :: Int) -> + _expressionsIcounter + {-# INLINE rule1478 #-} + rule1478 = \ ((_expressionsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionsIdictionaryEnvironment + {-# INLINE rule1479 #-} + rule1479 = \ ((_expressionsIpatternMatchWarnings) :: [Warning]) -> + _expressionsIpatternMatchWarnings + {-# INLINE rule1480 #-} + rule1480 = \ ((_expressionsIuniqueChunk) :: Int) -> + _expressionsIuniqueChunk + {-# INLINE rule1481 #-} + rule1481 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1482 #-} + rule1482 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1483 #-} + rule1483 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1484 #-} + rule1484 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1485 #-} + rule1485 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1486 #-} + rule1486 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1487 #-} + rule1487 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1488 #-} + rule1488 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1489 #-} + rule1489 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1490 #-} + rule1490 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1491 #-} + rule1491 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1492 #-} + rule1492 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1493 #-} + rule1493 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1494 #-} + rule1494 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1495 #-} + rule1495 = \ _parentTree -> + _parentTree + {-# INLINE rule1496 #-} + rule1496 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1497 #-} + rule1497 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1498 #-} + rule1498 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1499 #-} + rule1499 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1500 #-} + rule1500 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Expression_Tuple #-} +sem_Expression_Tuple :: T_Range -> T_Expressions -> T_Expression +sem_Expression_Tuple arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIassumptions _expressionsIbetaUnique _expressionsIbetas _expressionsIcollectErrors _expressionsIcollectInstances _expressionsIcollectWarnings _expressionsIconstraintslist _expressionsIcounter _expressionsIdictionaryEnvironment _expressionsIinfoTrees _expressionsImatchIO _expressionsImatches _expressionsIpatternMatchWarnings _expressionsIself _expressionsIunboundNames _expressionsIuniqueChunk _expressionsIuniqueSecondRound) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 _expressionsOallPatterns _expressionsOallTypeSchemes _expressionsOavailablePredicates _expressionsObetaUnique _expressionsOclassEnvironment _expressionsOcollectErrors _expressionsOcollectWarnings _expressionsOcounter _expressionsOcurrentChunk _expressionsOdictionaryEnvironment _expressionsOimportEnvironment _expressionsOmatchIO _expressionsOmonos _expressionsOnamesInScope _expressionsOorderedTypeSynonyms _expressionsOparentTree _expressionsOpatternMatchWarnings _expressionsOsubstitution _expressionsOtryPatterns _expressionsOtypeschemeMap _expressionsOuniqueChunk _expressionsOuniqueSecondRound) + _expressionsObetaUnique = rule1501 _lhsIbetaUnique + _constraints = rule1502 _expressionsIconstraintslist _newcon + _beta = rule1503 _lhsIbetaUnique + _newcon = rule1504 _beta _cinfo _expressionsIbetas + _cinfo = rule1505 _parentTree + _localInfo = rule1506 _beta _lhsImonos _self + _parentTree = rule1507 _expressionsIinfoTrees _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1508 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + (_expressionsOtryPatterns,_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule1509 _constraints _expressionsIassumptions _expressionsImatches _expressionsIuniqueSecondRound _lhsIallPatterns _lhsItryPatterns _localInfo + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1510 _expressionsImatchIO _ioMatch + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1511 _expressionsIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1512 _expressionsIunboundNames + _self = rule1513 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1514 _self + _lhsObeta :: Tp + _lhsObeta = rule1515 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1516 _expressionsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1517 _expressionsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1518 _expressionsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule1519 _expressionsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1520 _expressionsIdictionaryEnvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1521 _expressionsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1522 _expressionsIuniqueChunk + _expressionsOallPatterns = rule1523 _lhsIallPatterns + _expressionsOallTypeSchemes = rule1524 _lhsIallTypeSchemes + _expressionsOavailablePredicates = rule1525 _lhsIavailablePredicates + _expressionsOclassEnvironment = rule1526 _lhsIclassEnvironment + _expressionsOcollectErrors = rule1527 _lhsIcollectErrors + _expressionsOcollectWarnings = rule1528 _lhsIcollectWarnings + _expressionsOcounter = rule1529 _lhsIcounter + _expressionsOcurrentChunk = rule1530 _lhsIcurrentChunk + _expressionsOdictionaryEnvironment = rule1531 _lhsIdictionaryEnvironment + _expressionsOimportEnvironment = rule1532 _lhsIimportEnvironment + _expressionsOmatchIO = rule1533 _lhsImatchIO + _expressionsOmonos = rule1534 _lhsImonos + _expressionsOnamesInScope = rule1535 _lhsInamesInScope + _expressionsOorderedTypeSynonyms = rule1536 _lhsIorderedTypeSynonyms + _expressionsOparentTree = rule1537 _parentTree + _expressionsOpatternMatchWarnings = rule1538 _lhsIpatternMatchWarnings + _expressionsOsubstitution = rule1539 _lhsIsubstitution + _expressionsOtypeschemeMap = rule1540 _lhsItypeschemeMap + _expressionsOuniqueChunk = rule1541 _lhsIuniqueChunk + _expressionsOuniqueSecondRound = rule1542 _lhsIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1501 #-} + rule1501 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule1502 #-} + rule1502 = \ ((_expressionsIconstraintslist) :: ConstraintSets) _newcon -> + _newcon .>. Node _expressionsIconstraintslist + {-# INLINE rule1503 #-} + rule1503 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1504 #-} + rule1504 = \ _beta _cinfo ((_expressionsIbetas) :: Tps) -> + [ (tupleType _expressionsIbetas .==. _beta) _cinfo ] + {-# INLINE rule1505 #-} + rule1505 = \ _parentTree -> + resultConstraint "tuple" _parentTree + [ FolkloreConstraint ] + {-# INLINE rule1506 #-} + rule1506 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1507 #-} + rule1507 = \ ((_expressionsIinfoTrees) :: InfoTrees) ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo (_expressionsIinfoTrees) + {-# INLINE rule1508 #-} + rule1508 = \ _parentTree -> + _parentTree + {-# INLINE rule1509 #-} + rule1509 = \ _constraints ((_expressionsIassumptions) :: Assumptions) ((_expressionsImatches) :: [Maybe MetaVariableTable]) ((_expressionsIuniqueSecondRound) :: Int) ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo -> + let infoTuple = metaVarInfo _constraints _expressionsIassumptions _localInfo + in match1 infoTuple _expressionsIuniqueSecondRound + match_Expression_Tuple + _lhsItryPatterns _lhsIallPatterns + [_expressionsImatches] + {-# INLINE rule1510 #-} + rule1510 = \ ((_expressionsImatchIO) :: IO ()) _ioMatch -> + _expressionsImatchIO >> _ioMatch + {-# INLINE rule1511 #-} + rule1511 = \ ((_expressionsIcollectInstances) :: [(Name, Instance)]) -> + _expressionsIcollectInstances + {-# INLINE rule1512 #-} + rule1512 = \ ((_expressionsIunboundNames) :: Names) -> + _expressionsIunboundNames + {-# INLINE rule1513 #-} + rule1513 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_Tuple _rangeIself _expressionsIself + {-# INLINE rule1514 #-} + rule1514 = \ _self -> + _self + {-# INLINE rule1515 #-} + rule1515 = \ _beta -> + _beta + {-# INLINE rule1516 #-} + rule1516 = \ ((_expressionsIbetaUnique) :: Int) -> + _expressionsIbetaUnique + {-# INLINE rule1517 #-} + rule1517 = \ ((_expressionsIcollectErrors) :: TypeErrors) -> + _expressionsIcollectErrors + {-# INLINE rule1518 #-} + rule1518 = \ ((_expressionsIcollectWarnings) :: Warnings) -> + _expressionsIcollectWarnings + {-# INLINE rule1519 #-} + rule1519 = \ ((_expressionsIcounter) :: Int) -> + _expressionsIcounter + {-# INLINE rule1520 #-} + rule1520 = \ ((_expressionsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionsIdictionaryEnvironment + {-# INLINE rule1521 #-} + rule1521 = \ ((_expressionsIpatternMatchWarnings) :: [Warning]) -> + _expressionsIpatternMatchWarnings + {-# INLINE rule1522 #-} + rule1522 = \ ((_expressionsIuniqueChunk) :: Int) -> + _expressionsIuniqueChunk + {-# INLINE rule1523 #-} + rule1523 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1524 #-} + rule1524 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1525 #-} + rule1525 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1526 #-} + rule1526 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1527 #-} + rule1527 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1528 #-} + rule1528 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1529 #-} + rule1529 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1530 #-} + rule1530 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1531 #-} + rule1531 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1532 #-} + rule1532 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1533 #-} + rule1533 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1534 #-} + rule1534 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1535 #-} + rule1535 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1536 #-} + rule1536 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1537 #-} + rule1537 = \ _parentTree -> + _parentTree + {-# INLINE rule1538 #-} + rule1538 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1539 #-} + rule1539 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1540 #-} + rule1540 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1541 #-} + rule1541 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1542 #-} + rule1542 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Expression_Comprehension #-} +sem_Expression_Comprehension :: T_Range -> T_Expression -> T_Qualifiers -> T_Expression +sem_Expression_Comprehension arg_range_ arg_expression_ arg_qualifiers_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _qualifiersX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_qualifiers_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + (T_Qualifiers_vOut130 _qualifiersIassumptions _qualifiersIbetaUnique _qualifiersIcollectErrors _qualifiersIcollectInstances _qualifiersIcollectWarnings _qualifiersIconstraints _qualifiersIcounter _qualifiersIdictionaryEnvironment _qualifiersIinfoTrees _qualifiersImatchIO _qualifiersImonos _qualifiersInamesInScope _qualifiersIpatternMatchWarnings _qualifiersIself _qualifiersIunboundNames _qualifiersIuniqueChunk _qualifiersIuniqueSecondRound) = inv_Qualifiers_s131 _qualifiersX131 (T_Qualifiers_vIn130 _qualifiersOallPatterns _qualifiersOallTypeSchemes _qualifiersOassumptions _qualifiersOavailablePredicates _qualifiersObetaUnique _qualifiersOclassEnvironment _qualifiersOcollectErrors _qualifiersOcollectWarnings _qualifiersOconstraints _qualifiersOcounter _qualifiersOcurrentChunk _qualifiersOdictionaryEnvironment _qualifiersOimportEnvironment _qualifiersOmatchIO _qualifiersOmonos _qualifiersOnamesInScope _qualifiersOorderedTypeSynonyms _qualifiersOparentTree _qualifiersOpatternMatchWarnings _qualifiersOsubstitution _qualifiersOtypeschemeMap _qualifiersOunboundNames _qualifiersOuniqueChunk _qualifiersOuniqueSecondRound) + _expressionObetaUnique = rule1543 _lhsIbetaUnique + _expressionOmonos = rule1544 _qualifiersImonos + _qualifiersOassumptions = rule1545 _expressionIassumptions + _qualifiersOconstraints = rule1546 _expressionIconstraints + _qualifiersOmonos = rule1547 _lhsImonos + _assumptions = rule1548 _qualifiersIassumptions + _constraints = rule1549 _newcon _qualifiersIconstraints + _beta = rule1550 _lhsIbetaUnique + _newcon = rule1551 _beta _cinfo _expressionIbeta + _cinfo = rule1552 _parentTree + _localInfo = rule1553 _beta _lhsImonos _self + _parentTree = rule1554 _lhsIparentTree _localInfo _qualifiersIinfoTrees + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1555 _parentTree + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1556 _qualifiersIunboundNames + _expressionOnamesInScope = rule1557 _qualifiersInamesInScope + _qualifiersOnamesInScope = rule1558 _lhsInamesInScope + _qualifiersOunboundNames = rule1559 _expressionIunboundNames + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOmatches = rule1560 _assumptions _constraints _lhsItryPatterns _localInfo + _expressionOtryPatterns = rule1561 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1562 _expressionIcollectInstances _qualifiersIcollectInstances + _self = rule1563 _expressionIself _qualifiersIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1564 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule1565 _assumptions + _lhsObeta :: Tp + _lhsObeta = rule1566 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1567 _qualifiersIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1568 _qualifiersIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1569 _qualifiersIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule1570 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule1571 _qualifiersIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1572 _qualifiersIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1573 _qualifiersImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1574 _qualifiersIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1575 _qualifiersIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule1576 _qualifiersIuniqueSecondRound + _expressionOallPatterns = rule1577 _lhsIallPatterns + _expressionOallTypeSchemes = rule1578 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule1579 _lhsIavailablePredicates + _expressionOclassEnvironment = rule1580 _lhsIclassEnvironment + _expressionOcollectErrors = rule1581 _lhsIcollectErrors + _expressionOcollectWarnings = rule1582 _lhsIcollectWarnings + _expressionOcounter = rule1583 _lhsIcounter + _expressionOcurrentChunk = rule1584 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule1585 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule1586 _lhsIimportEnvironment + _expressionOmatchIO = rule1587 _lhsImatchIO + _expressionOorderedTypeSynonyms = rule1588 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule1589 _parentTree + _expressionOpatternMatchWarnings = rule1590 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule1591 _lhsIsubstitution + _expressionOtypeschemeMap = rule1592 _lhsItypeschemeMap + _expressionOuniqueChunk = rule1593 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule1594 _lhsIuniqueSecondRound + _qualifiersOallPatterns = rule1595 _lhsIallPatterns + _qualifiersOallTypeSchemes = rule1596 _lhsIallTypeSchemes + _qualifiersOavailablePredicates = rule1597 _lhsIavailablePredicates + _qualifiersObetaUnique = rule1598 _expressionIbetaUnique + _qualifiersOclassEnvironment = rule1599 _lhsIclassEnvironment + _qualifiersOcollectErrors = rule1600 _expressionIcollectErrors + _qualifiersOcollectWarnings = rule1601 _expressionIcollectWarnings + _qualifiersOcounter = rule1602 _expressionIcounter + _qualifiersOcurrentChunk = rule1603 _lhsIcurrentChunk + _qualifiersOdictionaryEnvironment = rule1604 _expressionIdictionaryEnvironment + _qualifiersOimportEnvironment = rule1605 _lhsIimportEnvironment + _qualifiersOmatchIO = rule1606 _expressionImatchIO + _qualifiersOorderedTypeSynonyms = rule1607 _lhsIorderedTypeSynonyms + _qualifiersOparentTree = rule1608 _parentTree + _qualifiersOpatternMatchWarnings = rule1609 _expressionIpatternMatchWarnings + _qualifiersOsubstitution = rule1610 _lhsIsubstitution + _qualifiersOtypeschemeMap = rule1611 _lhsItypeschemeMap + _qualifiersOuniqueChunk = rule1612 _expressionIuniqueChunk + _qualifiersOuniqueSecondRound = rule1613 _expressionIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1543 #-} + rule1543 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule1544 #-} + rule1544 = \ ((_qualifiersImonos) :: Monos) -> + _qualifiersImonos + {-# INLINE rule1545 #-} + rule1545 = \ ((_expressionIassumptions) :: Assumptions) -> + _expressionIassumptions + {-# INLINE rule1546 #-} + rule1546 = \ ((_expressionIconstraints) :: ConstraintSet) -> + _expressionIconstraints + {-# INLINE rule1547 #-} + rule1547 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1548 #-} + rule1548 = \ ((_qualifiersIassumptions) :: Assumptions) -> + _qualifiersIassumptions + {-# INLINE rule1549 #-} + rule1549 = \ _newcon ((_qualifiersIconstraints) :: ConstraintSet) -> + _newcon .>. Node [ _qualifiersIconstraints ] + {-# INLINE rule1550 #-} + rule1550 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1551 #-} + rule1551 = \ _beta _cinfo ((_expressionIbeta) :: Tp) -> + [ (listType _expressionIbeta .==. _beta) _cinfo ] + {-# INLINE rule1552 #-} + rule1552 = \ _parentTree -> + resultConstraint "list comprehension" _parentTree + [ FolkloreConstraint ] + {-# INLINE rule1553 #-} + rule1553 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1554 #-} + rule1554 = \ ((_lhsIparentTree) :: InfoTree) _localInfo ((_qualifiersIinfoTrees) :: InfoTrees) -> + node _lhsIparentTree _localInfo _qualifiersIinfoTrees + {-# INLINE rule1555 #-} + rule1555 = \ _parentTree -> + _parentTree + {-# INLINE rule1556 #-} + rule1556 = \ ((_qualifiersIunboundNames) :: Names) -> + _qualifiersIunboundNames + {-# INLINE rule1557 #-} + rule1557 = \ ((_qualifiersInamesInScope) :: Names) -> + _qualifiersInamesInScope + {-# INLINE rule1558 #-} + rule1558 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1559 #-} + rule1559 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule1560 #-} + rule1560 = \ _assumptions _constraints ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in matchOnlyVariable infoTuple _lhsItryPatterns + {-# INLINE rule1561 #-} + rule1561 = \ (_ :: ()) -> + [] + {-# INLINE rule1562 #-} + rule1562 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) ((_qualifiersIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances ++ _qualifiersIcollectInstances + {-# INLINE rule1563 #-} + rule1563 = \ ((_expressionIself) :: Expression) ((_qualifiersIself) :: Qualifiers) ((_rangeIself) :: Range) -> + Expression_Comprehension _rangeIself _expressionIself _qualifiersIself + {-# INLINE rule1564 #-} + rule1564 = \ _self -> + _self + {-# INLINE rule1565 #-} + rule1565 = \ _assumptions -> + _assumptions + {-# INLINE rule1566 #-} + rule1566 = \ _beta -> + _beta + {-# INLINE rule1567 #-} + rule1567 = \ ((_qualifiersIbetaUnique) :: Int) -> + _qualifiersIbetaUnique + {-# INLINE rule1568 #-} + rule1568 = \ ((_qualifiersIcollectErrors) :: TypeErrors) -> + _qualifiersIcollectErrors + {-# INLINE rule1569 #-} + rule1569 = \ ((_qualifiersIcollectWarnings) :: Warnings) -> + _qualifiersIcollectWarnings + {-# INLINE rule1570 #-} + rule1570 = \ _constraints -> + _constraints + {-# INLINE rule1571 #-} + rule1571 = \ ((_qualifiersIcounter) :: Int) -> + _qualifiersIcounter + {-# INLINE rule1572 #-} + rule1572 = \ ((_qualifiersIdictionaryEnvironment) :: DictionaryEnvironment) -> + _qualifiersIdictionaryEnvironment + {-# INLINE rule1573 #-} + rule1573 = \ ((_qualifiersImatchIO) :: IO ()) -> + _qualifiersImatchIO + {-# INLINE rule1574 #-} + rule1574 = \ ((_qualifiersIpatternMatchWarnings) :: [Warning]) -> + _qualifiersIpatternMatchWarnings + {-# INLINE rule1575 #-} + rule1575 = \ ((_qualifiersIuniqueChunk) :: Int) -> + _qualifiersIuniqueChunk + {-# INLINE rule1576 #-} + rule1576 = \ ((_qualifiersIuniqueSecondRound) :: Int) -> + _qualifiersIuniqueSecondRound + {-# INLINE rule1577 #-} + rule1577 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1578 #-} + rule1578 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1579 #-} + rule1579 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1580 #-} + rule1580 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1581 #-} + rule1581 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1582 #-} + rule1582 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1583 #-} + rule1583 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1584 #-} + rule1584 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1585 #-} + rule1585 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1586 #-} + rule1586 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1587 #-} + rule1587 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1588 #-} + rule1588 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1589 #-} + rule1589 = \ _parentTree -> + _parentTree + {-# INLINE rule1590 #-} + rule1590 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1591 #-} + rule1591 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1592 #-} + rule1592 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1593 #-} + rule1593 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1594 #-} + rule1594 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule1595 #-} + rule1595 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1596 #-} + rule1596 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1597 #-} + rule1597 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1598 #-} + rule1598 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule1599 #-} + rule1599 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1600 #-} + rule1600 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule1601 #-} + rule1601 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule1602 #-} + rule1602 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1603 #-} + rule1603 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1604 #-} + rule1604 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule1605 #-} + rule1605 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1606 #-} + rule1606 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule1607 #-} + rule1607 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1608 #-} + rule1608 = \ _parentTree -> + _parentTree + {-# INLINE rule1609 #-} + rule1609 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule1610 #-} + rule1610 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1611 #-} + rule1611 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1612 #-} + rule1612 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule1613 #-} + rule1613 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound +{-# NOINLINE sem_Expression_Typed #-} +sem_Expression_Typed :: T_Range -> T_Expression -> T_Type -> T_Expression +sem_Expression_Typed arg_range_ arg_expression_ arg_type_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _expressionObetaUnique = rule1614 _lhsIbetaUnique + _assumptions = rule1615 _expressionIassumptions + _constraints = rule1616 _conExpr _conResult _expressionIconstraints + _beta = rule1617 _lhsIbetaUnique + _typeScheme = rule1618 _typeIself + _conResult = rule1619 _beta _cinfoResult _typeScheme + _conExpr = rule1620 _cinfoExpr _expressionIbeta _lhsImonos _typeScheme + _cinfoExpr = rule1621 _parentTree _typeIself + _cinfoResult = rule1622 _parentTree + _localInfo = rule1623 _beta _lhsImonos _self + _parentTree = rule1624 _expressionIinfoTree _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1625 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOmatches = rule1626 _assumptions _constraints _lhsItryPatterns _localInfo + _expressionOtryPatterns = rule1627 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1628 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1629 _expressionIunboundNames + _self = rule1630 _expressionIself _rangeIself _typeIself + _lhsOself :: Expression + _lhsOself = rule1631 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule1632 _assumptions + _lhsObeta :: Tp + _lhsObeta = rule1633 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1634 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1635 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1636 _expressionIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule1637 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule1638 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1639 _expressionIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1640 _expressionImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1641 _expressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1642 _expressionIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule1643 _expressionIuniqueSecondRound + _expressionOallPatterns = rule1644 _lhsIallPatterns + _expressionOallTypeSchemes = rule1645 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule1646 _lhsIavailablePredicates + _expressionOclassEnvironment = rule1647 _lhsIclassEnvironment + _expressionOcollectErrors = rule1648 _lhsIcollectErrors + _expressionOcollectWarnings = rule1649 _lhsIcollectWarnings + _expressionOcounter = rule1650 _lhsIcounter + _expressionOcurrentChunk = rule1651 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule1652 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule1653 _lhsIimportEnvironment + _expressionOmatchIO = rule1654 _lhsImatchIO + _expressionOmonos = rule1655 _lhsImonos + _expressionOnamesInScope = rule1656 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule1657 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule1658 _parentTree + _expressionOpatternMatchWarnings = rule1659 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule1660 _lhsIsubstitution + _expressionOtypeschemeMap = rule1661 _lhsItypeschemeMap + _expressionOuniqueChunk = rule1662 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule1663 _lhsIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1614 #-} + rule1614 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule1615 #-} + rule1615 = \ ((_expressionIassumptions) :: Assumptions) -> + _expressionIassumptions + {-# INLINE rule1616 #-} + rule1616 = \ _conExpr _conResult ((_expressionIconstraints) :: ConstraintSet) -> + _conResult .>. + Node [ _conExpr .<. _expressionIconstraints ] + {-# INLINE rule1617 #-} + rule1617 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1618 #-} + rule1618 = \ ((_typeIself) :: Type) -> + makeTpSchemeFromType _typeIself + {-# INLINE rule1619 #-} + rule1619 = \ _beta _cinfoResult _typeScheme -> + [ (_beta .::. _typeScheme) _cinfoResult ] + {-# INLINE rule1620 #-} + rule1620 = \ _cinfoExpr ((_expressionIbeta) :: Tp) ((_lhsImonos) :: Monos) _typeScheme -> + [ (_expressionIbeta !::! _typeScheme) _lhsImonos _cinfoExpr ] + {-# INLINE rule1621 #-} + rule1621 = \ _parentTree ((_typeIself) :: Type) -> + childConstraint 0 "type annotation" _parentTree + [ TypeSignatureLocation (getTypeRange _typeIself) ] + {-# INLINE rule1622 #-} + rule1622 = \ _parentTree -> + resultConstraint "type annotation" _parentTree + [ FolkloreConstraint ] + {-# INLINE rule1623 #-} + rule1623 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1624 #-} + rule1624 = \ ((_expressionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [_expressionIinfoTree] + {-# INLINE rule1625 #-} + rule1625 = \ _parentTree -> + _parentTree + {-# INLINE rule1626 #-} + rule1626 = \ _assumptions _constraints ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in matchOnlyVariable infoTuple _lhsItryPatterns + {-# INLINE rule1627 #-} + rule1627 = \ (_ :: ()) -> + [] + {-# INLINE rule1628 #-} + rule1628 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule1629 #-} + rule1629 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule1630 #-} + rule1630 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Expression_Typed _rangeIself _expressionIself _typeIself + {-# INLINE rule1631 #-} + rule1631 = \ _self -> + _self + {-# INLINE rule1632 #-} + rule1632 = \ _assumptions -> + _assumptions + {-# INLINE rule1633 #-} + rule1633 = \ _beta -> + _beta + {-# INLINE rule1634 #-} + rule1634 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule1635 #-} + rule1635 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule1636 #-} + rule1636 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule1637 #-} + rule1637 = \ _constraints -> + _constraints + {-# INLINE rule1638 #-} + rule1638 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1639 #-} + rule1639 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule1640 #-} + rule1640 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule1641 #-} + rule1641 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule1642 #-} + rule1642 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule1643 #-} + rule1643 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule1644 #-} + rule1644 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1645 #-} + rule1645 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1646 #-} + rule1646 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1647 #-} + rule1647 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1648 #-} + rule1648 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1649 #-} + rule1649 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1650 #-} + rule1650 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1651 #-} + rule1651 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1652 #-} + rule1652 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1653 #-} + rule1653 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1654 #-} + rule1654 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1655 #-} + rule1655 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1656 #-} + rule1656 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1657 #-} + rule1657 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1658 #-} + rule1658 = \ _parentTree -> + _parentTree + {-# INLINE rule1659 #-} + rule1659 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1660 #-} + rule1660 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1661 #-} + rule1661 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1662 #-} + rule1662 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1663 #-} + rule1663 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Expression_RecordConstruction #-} +sem_Expression_RecordConstruction :: T_Range -> T_Name -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordConstruction arg_range_ arg_name_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIcollectErrors _recordExpressionBindingsIcollectInstances _recordExpressionBindingsIcollectWarnings _recordExpressionBindingsIcounter _recordExpressionBindingsIdictionaryEnvironment _recordExpressionBindingsIpatternMatchWarnings _recordExpressionBindingsIself _recordExpressionBindingsIunboundNames _recordExpressionBindingsIuniqueChunk) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 _recordExpressionBindingsOallTypeSchemes _recordExpressionBindingsOavailablePredicates _recordExpressionBindingsOclassEnvironment _recordExpressionBindingsOcollectErrors _recordExpressionBindingsOcollectWarnings _recordExpressionBindingsOcounter _recordExpressionBindingsOcurrentChunk _recordExpressionBindingsOdictionaryEnvironment _recordExpressionBindingsOimportEnvironment _recordExpressionBindingsOnamesInScope _recordExpressionBindingsOorderedTypeSynonyms _recordExpressionBindingsOpatternMatchWarnings _recordExpressionBindingsOsubstitution _recordExpressionBindingsOtypeschemeMap _recordExpressionBindingsOuniqueChunk) + _infoTree = rule1664 () + (_assumptions,_constraints,_beta) = rule1665 () + _matches = rule1666 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1667 _recordExpressionBindingsIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1668 _recordExpressionBindingsIunboundNames + _self = rule1669 _nameIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule1670 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule1671 _assumptions + _lhsObeta :: Tp + _lhsObeta = rule1672 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1673 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1674 _recordExpressionBindingsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1675 _recordExpressionBindingsIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule1676 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule1677 _recordExpressionBindingsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1678 _recordExpressionBindingsIdictionaryEnvironment + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1679 _infoTree + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1680 _lhsImatchIO + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOmatches = rule1681 _matches + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1682 _recordExpressionBindingsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1683 _recordExpressionBindingsIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule1684 _lhsIuniqueSecondRound + _recordExpressionBindingsOallTypeSchemes = rule1685 _lhsIallTypeSchemes + _recordExpressionBindingsOavailablePredicates = rule1686 _lhsIavailablePredicates + _recordExpressionBindingsOclassEnvironment = rule1687 _lhsIclassEnvironment + _recordExpressionBindingsOcollectErrors = rule1688 _lhsIcollectErrors + _recordExpressionBindingsOcollectWarnings = rule1689 _lhsIcollectWarnings + _recordExpressionBindingsOcounter = rule1690 _lhsIcounter + _recordExpressionBindingsOcurrentChunk = rule1691 _lhsIcurrentChunk + _recordExpressionBindingsOdictionaryEnvironment = rule1692 _lhsIdictionaryEnvironment + _recordExpressionBindingsOimportEnvironment = rule1693 _lhsIimportEnvironment + _recordExpressionBindingsOnamesInScope = rule1694 _lhsInamesInScope + _recordExpressionBindingsOorderedTypeSynonyms = rule1695 _lhsIorderedTypeSynonyms + _recordExpressionBindingsOpatternMatchWarnings = rule1696 _lhsIpatternMatchWarnings + _recordExpressionBindingsOsubstitution = rule1697 _lhsIsubstitution + _recordExpressionBindingsOtypeschemeMap = rule1698 _lhsItypeschemeMap + _recordExpressionBindingsOuniqueChunk = rule1699 _lhsIuniqueChunk + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1664 #-} + rule1664 = \ (_ :: ()) -> + globalInfoError + {-# INLINE rule1665 #-} + rule1665 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "Expression.RecordConstruction" + {-# INLINE rule1666 #-} + rule1666 = \ (_ :: ()) -> + internalError "TS_PatternMatching.ag" "n/a" "RecordConstruction is not supported" + {-# INLINE rule1667 #-} + rule1667 = \ ((_recordExpressionBindingsIcollectInstances) :: [(Name, Instance)]) -> + _recordExpressionBindingsIcollectInstances + {-# INLINE rule1668 #-} + rule1668 = \ ((_recordExpressionBindingsIunboundNames) :: Names) -> + _recordExpressionBindingsIunboundNames + {-# INLINE rule1669 #-} + rule1669 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordConstruction _rangeIself _nameIself _recordExpressionBindingsIself + {-# INLINE rule1670 #-} + rule1670 = \ _self -> + _self + {-# INLINE rule1671 #-} + rule1671 = \ _assumptions -> + _assumptions + {-# INLINE rule1672 #-} + rule1672 = \ _beta -> + _beta + {-# INLINE rule1673 #-} + rule1673 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule1674 #-} + rule1674 = \ ((_recordExpressionBindingsIcollectErrors) :: TypeErrors) -> + _recordExpressionBindingsIcollectErrors + {-# INLINE rule1675 #-} + rule1675 = \ ((_recordExpressionBindingsIcollectWarnings) :: Warnings) -> + _recordExpressionBindingsIcollectWarnings + {-# INLINE rule1676 #-} + rule1676 = \ _constraints -> + _constraints + {-# INLINE rule1677 #-} + rule1677 = \ ((_recordExpressionBindingsIcounter) :: Int) -> + _recordExpressionBindingsIcounter + {-# INLINE rule1678 #-} + rule1678 = \ ((_recordExpressionBindingsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _recordExpressionBindingsIdictionaryEnvironment + {-# INLINE rule1679 #-} + rule1679 = \ _infoTree -> + _infoTree + {-# INLINE rule1680 #-} + rule1680 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1681 #-} + rule1681 = \ _matches -> + _matches + {-# INLINE rule1682 #-} + rule1682 = \ ((_recordExpressionBindingsIpatternMatchWarnings) :: [Warning]) -> + _recordExpressionBindingsIpatternMatchWarnings + {-# INLINE rule1683 #-} + rule1683 = \ ((_recordExpressionBindingsIuniqueChunk) :: Int) -> + _recordExpressionBindingsIuniqueChunk + {-# INLINE rule1684 #-} + rule1684 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule1685 #-} + rule1685 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1686 #-} + rule1686 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1687 #-} + rule1687 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1688 #-} + rule1688 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1689 #-} + rule1689 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1690 #-} + rule1690 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1691 #-} + rule1691 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1692 #-} + rule1692 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1693 #-} + rule1693 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1694 #-} + rule1694 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1695 #-} + rule1695 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1696 #-} + rule1696 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1697 #-} + rule1697 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1698 #-} + rule1698 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1699 #-} + rule1699 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Expression_RecordUpdate #-} +sem_Expression_RecordUpdate :: T_Range -> T_Expression -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordUpdate arg_range_ arg_expression_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIcollectErrors _recordExpressionBindingsIcollectInstances _recordExpressionBindingsIcollectWarnings _recordExpressionBindingsIcounter _recordExpressionBindingsIdictionaryEnvironment _recordExpressionBindingsIpatternMatchWarnings _recordExpressionBindingsIself _recordExpressionBindingsIunboundNames _recordExpressionBindingsIuniqueChunk) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 _recordExpressionBindingsOallTypeSchemes _recordExpressionBindingsOavailablePredicates _recordExpressionBindingsOclassEnvironment _recordExpressionBindingsOcollectErrors _recordExpressionBindingsOcollectWarnings _recordExpressionBindingsOcounter _recordExpressionBindingsOcurrentChunk _recordExpressionBindingsOdictionaryEnvironment _recordExpressionBindingsOimportEnvironment _recordExpressionBindingsOnamesInScope _recordExpressionBindingsOorderedTypeSynonyms _recordExpressionBindingsOpatternMatchWarnings _recordExpressionBindingsOsubstitution _recordExpressionBindingsOtypeschemeMap _recordExpressionBindingsOuniqueChunk) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1700 _expressionIcollectInstances _recordExpressionBindingsIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1701 _expressionIunboundNames _recordExpressionBindingsIunboundNames + _self = rule1702 _expressionIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule1703 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule1704 _expressionIassumptions + _lhsObeta :: Tp + _lhsObeta = rule1705 _expressionIbeta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1706 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1707 _recordExpressionBindingsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1708 _recordExpressionBindingsIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule1709 _expressionIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule1710 _recordExpressionBindingsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1711 _recordExpressionBindingsIdictionaryEnvironment + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1712 _expressionIinfoTree + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1713 _expressionImatchIO + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOmatches = rule1714 _expressionImatches + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1715 _recordExpressionBindingsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1716 _recordExpressionBindingsIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule1717 _expressionIuniqueSecondRound + _expressionOallPatterns = rule1718 _lhsIallPatterns + _expressionOallTypeSchemes = rule1719 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule1720 _lhsIavailablePredicates + _expressionObetaUnique = rule1721 _lhsIbetaUnique + _expressionOclassEnvironment = rule1722 _lhsIclassEnvironment + _expressionOcollectErrors = rule1723 _lhsIcollectErrors + _expressionOcollectWarnings = rule1724 _lhsIcollectWarnings + _expressionOcounter = rule1725 _lhsIcounter + _expressionOcurrentChunk = rule1726 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule1727 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule1728 _lhsIimportEnvironment + _expressionOmatchIO = rule1729 _lhsImatchIO + _expressionOmonos = rule1730 _lhsImonos + _expressionOnamesInScope = rule1731 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule1732 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule1733 _lhsIparentTree + _expressionOpatternMatchWarnings = rule1734 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule1735 _lhsIsubstitution + _expressionOtryPatterns = rule1736 _lhsItryPatterns + _expressionOtypeschemeMap = rule1737 _lhsItypeschemeMap + _expressionOuniqueChunk = rule1738 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule1739 _lhsIuniqueSecondRound + _recordExpressionBindingsOallTypeSchemes = rule1740 _lhsIallTypeSchemes + _recordExpressionBindingsOavailablePredicates = rule1741 _lhsIavailablePredicates + _recordExpressionBindingsOclassEnvironment = rule1742 _lhsIclassEnvironment + _recordExpressionBindingsOcollectErrors = rule1743 _expressionIcollectErrors + _recordExpressionBindingsOcollectWarnings = rule1744 _expressionIcollectWarnings + _recordExpressionBindingsOcounter = rule1745 _expressionIcounter + _recordExpressionBindingsOcurrentChunk = rule1746 _lhsIcurrentChunk + _recordExpressionBindingsOdictionaryEnvironment = rule1747 _expressionIdictionaryEnvironment + _recordExpressionBindingsOimportEnvironment = rule1748 _lhsIimportEnvironment + _recordExpressionBindingsOnamesInScope = rule1749 _lhsInamesInScope + _recordExpressionBindingsOorderedTypeSynonyms = rule1750 _lhsIorderedTypeSynonyms + _recordExpressionBindingsOpatternMatchWarnings = rule1751 _expressionIpatternMatchWarnings + _recordExpressionBindingsOsubstitution = rule1752 _lhsIsubstitution + _recordExpressionBindingsOtypeschemeMap = rule1753 _lhsItypeschemeMap + _recordExpressionBindingsOuniqueChunk = rule1754 _expressionIuniqueChunk + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1700 #-} + rule1700 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) ((_recordExpressionBindingsIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances ++ _recordExpressionBindingsIcollectInstances + {-# INLINE rule1701 #-} + rule1701 = \ ((_expressionIunboundNames) :: Names) ((_recordExpressionBindingsIunboundNames) :: Names) -> + _expressionIunboundNames ++ _recordExpressionBindingsIunboundNames + {-# INLINE rule1702 #-} + rule1702 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordUpdate _rangeIself _expressionIself _recordExpressionBindingsIself + {-# INLINE rule1703 #-} + rule1703 = \ _self -> + _self + {-# INLINE rule1704 #-} + rule1704 = \ ((_expressionIassumptions) :: Assumptions) -> + _expressionIassumptions + {-# INLINE rule1705 #-} + rule1705 = \ ((_expressionIbeta) :: Tp) -> + _expressionIbeta + {-# INLINE rule1706 #-} + rule1706 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule1707 #-} + rule1707 = \ ((_recordExpressionBindingsIcollectErrors) :: TypeErrors) -> + _recordExpressionBindingsIcollectErrors + {-# INLINE rule1708 #-} + rule1708 = \ ((_recordExpressionBindingsIcollectWarnings) :: Warnings) -> + _recordExpressionBindingsIcollectWarnings + {-# INLINE rule1709 #-} + rule1709 = \ ((_expressionIconstraints) :: ConstraintSet) -> + _expressionIconstraints + {-# INLINE rule1710 #-} + rule1710 = \ ((_recordExpressionBindingsIcounter) :: Int) -> + _recordExpressionBindingsIcounter + {-# INLINE rule1711 #-} + rule1711 = \ ((_recordExpressionBindingsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _recordExpressionBindingsIdictionaryEnvironment + {-# INLINE rule1712 #-} + rule1712 = \ ((_expressionIinfoTree) :: InfoTree) -> + _expressionIinfoTree + {-# INLINE rule1713 #-} + rule1713 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule1714 #-} + rule1714 = \ ((_expressionImatches) :: [Maybe MetaVariableTable]) -> + _expressionImatches + {-# INLINE rule1715 #-} + rule1715 = \ ((_recordExpressionBindingsIpatternMatchWarnings) :: [Warning]) -> + _recordExpressionBindingsIpatternMatchWarnings + {-# INLINE rule1716 #-} + rule1716 = \ ((_recordExpressionBindingsIuniqueChunk) :: Int) -> + _recordExpressionBindingsIuniqueChunk + {-# INLINE rule1717 #-} + rule1717 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule1718 #-} + rule1718 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1719 #-} + rule1719 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1720 #-} + rule1720 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1721 #-} + rule1721 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule1722 #-} + rule1722 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1723 #-} + rule1723 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1724 #-} + rule1724 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1725 #-} + rule1725 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1726 #-} + rule1726 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1727 #-} + rule1727 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1728 #-} + rule1728 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1729 #-} + rule1729 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1730 #-} + rule1730 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1731 #-} + rule1731 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1732 #-} + rule1732 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1733 #-} + rule1733 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule1734 #-} + rule1734 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1735 #-} + rule1735 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1736 #-} + rule1736 = \ ((_lhsItryPatterns) :: [(Expression , [String])]) -> + _lhsItryPatterns + {-# INLINE rule1737 #-} + rule1737 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1738 #-} + rule1738 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1739 #-} + rule1739 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule1740 #-} + rule1740 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1741 #-} + rule1741 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1742 #-} + rule1742 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1743 #-} + rule1743 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule1744 #-} + rule1744 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule1745 #-} + rule1745 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1746 #-} + rule1746 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1747 #-} + rule1747 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule1748 #-} + rule1748 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1749 #-} + rule1749 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1750 #-} + rule1750 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1751 #-} + rule1751 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule1752 #-} + rule1752 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1753 #-} + rule1753 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1754 #-} + rule1754 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk +{-# NOINLINE sem_Expression_Enum #-} +sem_Expression_Enum :: T_Range -> T_Expression -> T_MaybeExpression -> T_MaybeExpression -> T_Expression +sem_Expression_Enum arg_range_ arg_from_ arg_then_ arg_to_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fromX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_from_)) + _thenX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_then_)) + _toX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_to_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _fromIassumptions _fromIbeta _fromIbetaUnique _fromIcollectErrors _fromIcollectInstances _fromIcollectWarnings _fromIconstraints _fromIcounter _fromIdictionaryEnvironment _fromIinfoTree _fromImatchIO _fromImatches _fromIpatternMatchWarnings _fromIself _fromIunboundNames _fromIuniqueChunk _fromIuniqueSecondRound) = inv_Expression_s41 _fromX41 (T_Expression_vIn40 _fromOallPatterns _fromOallTypeSchemes _fromOavailablePredicates _fromObetaUnique _fromOclassEnvironment _fromOcollectErrors _fromOcollectWarnings _fromOcounter _fromOcurrentChunk _fromOdictionaryEnvironment _fromOimportEnvironment _fromOmatchIO _fromOmonos _fromOnamesInScope _fromOorderedTypeSynonyms _fromOparentTree _fromOpatternMatchWarnings _fromOsubstitution _fromOtryPatterns _fromOtypeschemeMap _fromOuniqueChunk _fromOuniqueSecondRound) + (T_MaybeExpression_vOut94 _thenIassumptions _thenIbeta _thenIbetaUnique _thenIcollectErrors _thenIcollectInstances _thenIcollectWarnings _thenIconstraints _thenIcounter _thenIdictionaryEnvironment _thenIinfoTrees _thenImatchIO _thenImatches _thenIpatternMatchWarnings _thenIsection _thenIself _thenIunboundNames _thenIuniqueChunk _thenIuniqueSecondRound) = inv_MaybeExpression_s95 _thenX95 (T_MaybeExpression_vIn94 _thenOallPatterns _thenOallTypeSchemes _thenOavailablePredicates _thenObetaUnique _thenOclassEnvironment _thenOcollectErrors _thenOcollectWarnings _thenOcounter _thenOcurrentChunk _thenOdictionaryEnvironment _thenOimportEnvironment _thenOmatchIO _thenOmonos _thenOnamesInScope _thenOorderedTypeSynonyms _thenOparentTree _thenOpatternMatchWarnings _thenOsubstitution _thenOtryPatterns _thenOtypeschemeMap _thenOuniqueChunk _thenOuniqueSecondRound) + (T_MaybeExpression_vOut94 _toIassumptions _toIbeta _toIbetaUnique _toIcollectErrors _toIcollectInstances _toIcollectWarnings _toIconstraints _toIcounter _toIdictionaryEnvironment _toIinfoTrees _toImatchIO _toImatches _toIpatternMatchWarnings _toIsection _toIself _toIunboundNames _toIuniqueChunk _toIuniqueSecondRound) = inv_MaybeExpression_s95 _toX95 (T_MaybeExpression_vIn94 _toOallPatterns _toOallTypeSchemes _toOavailablePredicates _toObetaUnique _toOclassEnvironment _toOcollectErrors _toOcollectWarnings _toOcounter _toOcurrentChunk _toOdictionaryEnvironment _toOimportEnvironment _toOmatchIO _toOmonos _toOnamesInScope _toOorderedTypeSynonyms _toOparentTree _toOpatternMatchWarnings _toOsubstitution _toOtryPatterns _toOtypeschemeMap _toOuniqueChunk _toOuniqueSecondRound) + _fromObetaUnique = rule1755 _lhsIbetaUnique _overloaded + _assumptions = rule1756 _fromIassumptions _thenIassumptions _toIassumptions + _constraints = rule1757 _conFrom _conList _conPredicate _conThen _conTo _fromIconstraints _thenIconstraints _toIconstraints + _beta = rule1758 _lhsIbetaUnique + _overloaded = rule1759 _lhsIimportEnvironment + _elementType = rule1760 _lhsIbetaUnique _overloaded + _conPredicate = rule1761 _cinfoPred _elementType _overloaded + _conList = rule1762 _beta _cinfoResult _elementType + _conFrom = rule1763 _cinfoFrom _elementType _fromIbeta + _conThen = rule1764 _cinfoThen _elementType _thenIbeta + _conTo = rule1765 _cinfoTo _elementType _toIbeta + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1766 _newDEnv + _localName = rule1767 _rangeIself _thenIsection _toIsection + _requiredDictionaries = rule1768 _elementType _lhsIsubstitution _overloaded + _newDEnv = rule1769 _lhsIavailablePredicates _lhsIclassEnvironment _lhsIsubstitution _localName _requiredDictionaries _toIdictionaryEnvironment + _cinfoFrom = rule1770 _parentTree + _cinfoThen = rule1771 _parentTree + _toChildNr = rule1772 _thenIinfoTrees + _cinfoTo = rule1773 _parentTree _toChildNr + _cinfoResult = rule1774 _parentTree + _cinfoPred = rule1775 _elementType _parentTree + _localInfo = rule1776 _beta _lhsImonos _self + _parentTree = rule1777 _fromIinfoTree _lhsIparentTree _localInfo _thenIinfoTrees _toIinfoTrees + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1778 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + ((_fromOtryPatterns,_thenOtryPatterns,_toOtryPatterns),_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule1779 _assumptions _constraints _fromImatches _lhsIallPatterns _lhsItryPatterns _localInfo _thenImatches _toImatches _toIuniqueSecondRound + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1780 _ioMatch _toImatchIO + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1781 _fromIcollectInstances _thenIcollectInstances _toIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1782 _fromIunboundNames _thenIunboundNames _toIunboundNames + _self = rule1783 _fromIself _rangeIself _thenIself _toIself + _lhsOself :: Expression + _lhsOself = rule1784 _self + _lhsObeta :: Tp + _lhsObeta = rule1785 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1786 _toIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1787 _toIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1788 _toIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule1789 _toIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1790 _toIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1791 _toIuniqueChunk + _fromOallPatterns = rule1792 _lhsIallPatterns + _fromOallTypeSchemes = rule1793 _lhsIallTypeSchemes + _fromOavailablePredicates = rule1794 _lhsIavailablePredicates + _fromOclassEnvironment = rule1795 _lhsIclassEnvironment + _fromOcollectErrors = rule1796 _lhsIcollectErrors + _fromOcollectWarnings = rule1797 _lhsIcollectWarnings + _fromOcounter = rule1798 _lhsIcounter + _fromOcurrentChunk = rule1799 _lhsIcurrentChunk + _fromOdictionaryEnvironment = rule1800 _lhsIdictionaryEnvironment + _fromOimportEnvironment = rule1801 _lhsIimportEnvironment + _fromOmatchIO = rule1802 _lhsImatchIO + _fromOmonos = rule1803 _lhsImonos + _fromOnamesInScope = rule1804 _lhsInamesInScope + _fromOorderedTypeSynonyms = rule1805 _lhsIorderedTypeSynonyms + _fromOparentTree = rule1806 _parentTree + _fromOpatternMatchWarnings = rule1807 _lhsIpatternMatchWarnings + _fromOsubstitution = rule1808 _lhsIsubstitution + _fromOtypeschemeMap = rule1809 _lhsItypeschemeMap + _fromOuniqueChunk = rule1810 _lhsIuniqueChunk + _fromOuniqueSecondRound = rule1811 _lhsIuniqueSecondRound + _thenOallPatterns = rule1812 _lhsIallPatterns + _thenOallTypeSchemes = rule1813 _lhsIallTypeSchemes + _thenOavailablePredicates = rule1814 _lhsIavailablePredicates + _thenObetaUnique = rule1815 _fromIbetaUnique + _thenOclassEnvironment = rule1816 _lhsIclassEnvironment + _thenOcollectErrors = rule1817 _fromIcollectErrors + _thenOcollectWarnings = rule1818 _fromIcollectWarnings + _thenOcounter = rule1819 _fromIcounter + _thenOcurrentChunk = rule1820 _lhsIcurrentChunk + _thenOdictionaryEnvironment = rule1821 _fromIdictionaryEnvironment + _thenOimportEnvironment = rule1822 _lhsIimportEnvironment + _thenOmatchIO = rule1823 _fromImatchIO + _thenOmonos = rule1824 _lhsImonos + _thenOnamesInScope = rule1825 _lhsInamesInScope + _thenOorderedTypeSynonyms = rule1826 _lhsIorderedTypeSynonyms + _thenOparentTree = rule1827 _parentTree + _thenOpatternMatchWarnings = rule1828 _fromIpatternMatchWarnings + _thenOsubstitution = rule1829 _lhsIsubstitution + _thenOtypeschemeMap = rule1830 _lhsItypeschemeMap + _thenOuniqueChunk = rule1831 _fromIuniqueChunk + _thenOuniqueSecondRound = rule1832 _fromIuniqueSecondRound + _toOallPatterns = rule1833 _lhsIallPatterns + _toOallTypeSchemes = rule1834 _lhsIallTypeSchemes + _toOavailablePredicates = rule1835 _lhsIavailablePredicates + _toObetaUnique = rule1836 _thenIbetaUnique + _toOclassEnvironment = rule1837 _lhsIclassEnvironment + _toOcollectErrors = rule1838 _thenIcollectErrors + _toOcollectWarnings = rule1839 _thenIcollectWarnings + _toOcounter = rule1840 _thenIcounter + _toOcurrentChunk = rule1841 _lhsIcurrentChunk + _toOdictionaryEnvironment = rule1842 _thenIdictionaryEnvironment + _toOimportEnvironment = rule1843 _lhsIimportEnvironment + _toOmatchIO = rule1844 _thenImatchIO + _toOmonos = rule1845 _lhsImonos + _toOnamesInScope = rule1846 _lhsInamesInScope + _toOorderedTypeSynonyms = rule1847 _lhsIorderedTypeSynonyms + _toOparentTree = rule1848 _parentTree + _toOpatternMatchWarnings = rule1849 _thenIpatternMatchWarnings + _toOsubstitution = rule1850 _lhsIsubstitution + _toOtypeschemeMap = rule1851 _lhsItypeschemeMap + _toOuniqueChunk = rule1852 _thenIuniqueChunk + _toOuniqueSecondRound = rule1853 _thenIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1755 #-} + rule1755 = \ ((_lhsIbetaUnique) :: Int) _overloaded -> + _lhsIbetaUnique + (if _overloaded then 2 else 1) + {-# INLINE rule1756 #-} + rule1756 = \ ((_fromIassumptions) :: Assumptions) ((_thenIassumptions) :: Assumptions) ((_toIassumptions) :: Assumptions) -> + _fromIassumptions `combine` _thenIassumptions `combine` _toIassumptions + {-# INLINE rule1757 #-} + rule1757 = \ _conFrom _conList _conPredicate _conThen _conTo ((_fromIconstraints) :: ConstraintSet) ((_thenIconstraints) :: ConstraintSet) ((_toIconstraints) :: ConstraintSet) -> + (_conList ++ _conPredicate) .>. + Node [ _conFrom .<. _fromIconstraints + , _conThen .<. _thenIconstraints + , _conTo .<. _toIconstraints + ] + {-# INLINE rule1758 #-} + rule1758 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1759 #-} + rule1759 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + case M.lookup enumFromName (typeEnvironment _lhsIimportEnvironment) of + Just scheme -> isOverloaded scheme + Nothing -> False + {-# INLINE rule1760 #-} + rule1760 = \ ((_lhsIbetaUnique) :: Int) _overloaded -> + if _overloaded then TVar (_lhsIbetaUnique + 1) else intType + {-# INLINE rule1761 #-} + rule1761 = \ _cinfoPred _elementType _overloaded -> + if _overloaded then [predicate (Predicate "Enum" _elementType) _cinfoPred] else [] + {-# INLINE rule1762 #-} + rule1762 = \ _beta _cinfoResult _elementType -> + [ (listType _elementType .==. _beta) _cinfoResult ] + {-# INLINE rule1763 #-} + rule1763 = \ _cinfoFrom _elementType ((_fromIbeta) :: Tp) -> + [ (_fromIbeta .==. _elementType) _cinfoFrom ] + {-# INLINE rule1764 #-} + rule1764 = \ _cinfoThen _elementType ((_thenIbeta) :: Tp) -> + [ (_thenIbeta .==. _elementType) _cinfoThen ] + {-# INLINE rule1765 #-} + rule1765 = \ _cinfoTo _elementType ((_toIbeta) :: Tp) -> + [ (_toIbeta .==. _elementType) _cinfoTo ] + {-# INLINE rule1766 #-} + rule1766 = \ _newDEnv -> + _newDEnv + {-# INLINE rule1767 #-} + rule1767 = \ ((_rangeIself) :: Range) ((_thenIsection) :: Bool) ((_toIsection) :: Bool) -> + flip setNameRange _rangeIself $ + case (_thenIsection, _toIsection) of + (False, False) -> enumFromThenToName + (False, True ) -> enumFromThenName + (True , False) -> enumFromToName + (True , True ) -> enumFromName + {-# INLINE rule1768 #-} + rule1768 = \ _elementType ((_lhsIsubstitution) :: FixpointSubstitution) _overloaded -> + if _overloaded then _lhsIsubstitution |-> [Predicate "Enum" _elementType] else [] + {-# INLINE rule1769 #-} + rule1769 = \ ((_lhsIavailablePredicates) :: Predicates) ((_lhsIclassEnvironment) :: ClassEnvironment) ((_lhsIsubstitution) :: FixpointSubstitution) _localName _requiredDictionaries ((_toIdictionaryEnvironment) :: DictionaryEnvironment) -> + resolveOverloading (_lhsIclassEnvironment) _localName + (_lhsIsubstitution |-> _lhsIavailablePredicates) + (_lhsIsubstitution |-> _requiredDictionaries) + _toIdictionaryEnvironment + {-# INLINE rule1770 #-} + rule1770 = \ _parentTree -> + childConstraint 0 "enumeration" _parentTree + [] + {-# INLINE rule1771 #-} + rule1771 = \ _parentTree -> + childConstraint 1 "enumeration" _parentTree + [] + {-# INLINE rule1772 #-} + rule1772 = \ ((_thenIinfoTrees) :: InfoTrees) -> + 1 + length _thenIinfoTrees + {-# INLINE rule1773 #-} + rule1773 = \ _parentTree _toChildNr -> + childConstraint _toChildNr "enumeration" _parentTree + [] + {-# INLINE rule1774 #-} + rule1774 = \ _parentTree -> + resultConstraint "enumeration" _parentTree + [ FolkloreConstraint ] + {-# INLINE rule1775 #-} + rule1775 = \ _elementType _parentTree -> + resultConstraint "enumeration" _parentTree + [ ReductionErrorInfo (Predicate "Enum" _elementType) ] + {-# INLINE rule1776 #-} + rule1776 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1777 #-} + rule1777 = \ ((_fromIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo ((_thenIinfoTrees) :: InfoTrees) ((_toIinfoTrees) :: InfoTrees) -> + node _lhsIparentTree _localInfo (_fromIinfoTree : _thenIinfoTrees ++ _toIinfoTrees) + {-# INLINE rule1778 #-} + rule1778 = \ _parentTree -> + _parentTree + {-# INLINE rule1779 #-} + rule1779 = \ _assumptions _constraints ((_fromImatches) :: [Maybe MetaVariableTable]) ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo ((_thenImatches) :: [Maybe MetaVariableTable]) ((_toImatches) :: [Maybe MetaVariableTable]) ((_toIuniqueSecondRound) :: Int) -> + let infoTuple = metaVarInfo _constraints _assumptions _localInfo + in match3 infoTuple _toIuniqueSecondRound + match_Expression_Enum + _lhsItryPatterns _lhsIallPatterns + [_fromImatches, _thenImatches, _toImatches] + {-# INLINE rule1780 #-} + rule1780 = \ _ioMatch ((_toImatchIO) :: IO ()) -> + _toImatchIO >> _ioMatch + {-# INLINE rule1781 #-} + rule1781 = \ ((_fromIcollectInstances) :: [(Name, Instance)]) ((_thenIcollectInstances) :: [(Name, Instance)]) ((_toIcollectInstances) :: [(Name, Instance)]) -> + _fromIcollectInstances ++ _thenIcollectInstances ++ _toIcollectInstances + {-# INLINE rule1782 #-} + rule1782 = \ ((_fromIunboundNames) :: Names) ((_thenIunboundNames) :: Names) ((_toIunboundNames) :: Names) -> + _fromIunboundNames ++ _thenIunboundNames ++ _toIunboundNames + {-# INLINE rule1783 #-} + rule1783 = \ ((_fromIself) :: Expression) ((_rangeIself) :: Range) ((_thenIself) :: MaybeExpression) ((_toIself) :: MaybeExpression) -> + Expression_Enum _rangeIself _fromIself _thenIself _toIself + {-# INLINE rule1784 #-} + rule1784 = \ _self -> + _self + {-# INLINE rule1785 #-} + rule1785 = \ _beta -> + _beta + {-# INLINE rule1786 #-} + rule1786 = \ ((_toIbetaUnique) :: Int) -> + _toIbetaUnique + {-# INLINE rule1787 #-} + rule1787 = \ ((_toIcollectErrors) :: TypeErrors) -> + _toIcollectErrors + {-# INLINE rule1788 #-} + rule1788 = \ ((_toIcollectWarnings) :: Warnings) -> + _toIcollectWarnings + {-# INLINE rule1789 #-} + rule1789 = \ ((_toIcounter) :: Int) -> + _toIcounter + {-# INLINE rule1790 #-} + rule1790 = \ ((_toIpatternMatchWarnings) :: [Warning]) -> + _toIpatternMatchWarnings + {-# INLINE rule1791 #-} + rule1791 = \ ((_toIuniqueChunk) :: Int) -> + _toIuniqueChunk + {-# INLINE rule1792 #-} + rule1792 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1793 #-} + rule1793 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1794 #-} + rule1794 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1795 #-} + rule1795 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1796 #-} + rule1796 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1797 #-} + rule1797 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1798 #-} + rule1798 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1799 #-} + rule1799 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1800 #-} + rule1800 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1801 #-} + rule1801 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1802 #-} + rule1802 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1803 #-} + rule1803 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1804 #-} + rule1804 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1805 #-} + rule1805 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1806 #-} + rule1806 = \ _parentTree -> + _parentTree + {-# INLINE rule1807 #-} + rule1807 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1808 #-} + rule1808 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1809 #-} + rule1809 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1810 #-} + rule1810 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1811 #-} + rule1811 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule1812 #-} + rule1812 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1813 #-} + rule1813 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1814 #-} + rule1814 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1815 #-} + rule1815 = \ ((_fromIbetaUnique) :: Int) -> + _fromIbetaUnique + {-# INLINE rule1816 #-} + rule1816 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1817 #-} + rule1817 = \ ((_fromIcollectErrors) :: TypeErrors) -> + _fromIcollectErrors + {-# INLINE rule1818 #-} + rule1818 = \ ((_fromIcollectWarnings) :: Warnings) -> + _fromIcollectWarnings + {-# INLINE rule1819 #-} + rule1819 = \ ((_fromIcounter) :: Int) -> + _fromIcounter + {-# INLINE rule1820 #-} + rule1820 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1821 #-} + rule1821 = \ ((_fromIdictionaryEnvironment) :: DictionaryEnvironment) -> + _fromIdictionaryEnvironment + {-# INLINE rule1822 #-} + rule1822 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1823 #-} + rule1823 = \ ((_fromImatchIO) :: IO ()) -> + _fromImatchIO + {-# INLINE rule1824 #-} + rule1824 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1825 #-} + rule1825 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1826 #-} + rule1826 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1827 #-} + rule1827 = \ _parentTree -> + _parentTree + {-# INLINE rule1828 #-} + rule1828 = \ ((_fromIpatternMatchWarnings) :: [Warning]) -> + _fromIpatternMatchWarnings + {-# INLINE rule1829 #-} + rule1829 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1830 #-} + rule1830 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1831 #-} + rule1831 = \ ((_fromIuniqueChunk) :: Int) -> + _fromIuniqueChunk + {-# INLINE rule1832 #-} + rule1832 = \ ((_fromIuniqueSecondRound) :: Int) -> + _fromIuniqueSecondRound + {-# INLINE rule1833 #-} + rule1833 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1834 #-} + rule1834 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1835 #-} + rule1835 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1836 #-} + rule1836 = \ ((_thenIbetaUnique) :: Int) -> + _thenIbetaUnique + {-# INLINE rule1837 #-} + rule1837 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1838 #-} + rule1838 = \ ((_thenIcollectErrors) :: TypeErrors) -> + _thenIcollectErrors + {-# INLINE rule1839 #-} + rule1839 = \ ((_thenIcollectWarnings) :: Warnings) -> + _thenIcollectWarnings + {-# INLINE rule1840 #-} + rule1840 = \ ((_thenIcounter) :: Int) -> + _thenIcounter + {-# INLINE rule1841 #-} + rule1841 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1842 #-} + rule1842 = \ ((_thenIdictionaryEnvironment) :: DictionaryEnvironment) -> + _thenIdictionaryEnvironment + {-# INLINE rule1843 #-} + rule1843 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1844 #-} + rule1844 = \ ((_thenImatchIO) :: IO ()) -> + _thenImatchIO + {-# INLINE rule1845 #-} + rule1845 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1846 #-} + rule1846 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1847 #-} + rule1847 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1848 #-} + rule1848 = \ _parentTree -> + _parentTree + {-# INLINE rule1849 #-} + rule1849 = \ ((_thenIpatternMatchWarnings) :: [Warning]) -> + _thenIpatternMatchWarnings + {-# INLINE rule1850 #-} + rule1850 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1851 #-} + rule1851 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1852 #-} + rule1852 = \ ((_thenIuniqueChunk) :: Int) -> + _thenIuniqueChunk + {-# INLINE rule1853 #-} + rule1853 = \ ((_thenIuniqueSecondRound) :: Int) -> + _thenIuniqueSecondRound +{-# NOINLINE sem_Expression_Negate #-} +sem_Expression_Negate :: T_Range -> T_Expression -> T_Expression +sem_Expression_Negate arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _expressionObetaUnique = rule1854 _lhsIbetaUnique + _constraints = rule1855 _expressionIconstraints _newcon + _beta = rule1856 _lhsIbetaUnique + _newcon = rule1857 _beta _cinfo _expressionIbeta _lhsIimportEnvironment + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1858 _newDEnv + _localName = rule1859 _rangeIself + _negateTypeScheme = rule1860 _lhsIimportEnvironment _localName + _requiredDictionaries = rule1861 _lhsIimportEnvironment _lhsIsubstitution _negateTypeScheme _usedAsType + _usedAsType = rule1862 _beta _expressionIbeta _lhsIsubstitution + _newDEnv = rule1863 _expressionIdictionaryEnvironment _lhsIavailablePredicates _lhsIclassEnvironment _lhsIsubstitution _localName _requiredDictionaries + _cinfo = rule1864 _localInfo _parentTree _rangeIself + _localInfo = rule1865 _beta _lhsImonos _self + _parentTree = rule1866 _expressionIinfoTree _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1867 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + (_expressionOtryPatterns,_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule1868 _constraints _expressionIassumptions _expressionImatches _expressionIuniqueSecondRound _lhsIallPatterns _lhsItryPatterns _localInfo + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1869 _expressionImatchIO _ioMatch + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1870 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1871 _expressionIunboundNames + _self = rule1872 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1873 _self + _lhsObeta :: Tp + _lhsObeta = rule1874 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1875 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1876 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1877 _expressionIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule1878 _expressionIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1879 _expressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1880 _expressionIuniqueChunk + _expressionOallPatterns = rule1881 _lhsIallPatterns + _expressionOallTypeSchemes = rule1882 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule1883 _lhsIavailablePredicates + _expressionOclassEnvironment = rule1884 _lhsIclassEnvironment + _expressionOcollectErrors = rule1885 _lhsIcollectErrors + _expressionOcollectWarnings = rule1886 _lhsIcollectWarnings + _expressionOcounter = rule1887 _lhsIcounter + _expressionOcurrentChunk = rule1888 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule1889 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule1890 _lhsIimportEnvironment + _expressionOmatchIO = rule1891 _lhsImatchIO + _expressionOmonos = rule1892 _lhsImonos + _expressionOnamesInScope = rule1893 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule1894 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule1895 _parentTree + _expressionOpatternMatchWarnings = rule1896 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule1897 _lhsIsubstitution + _expressionOtypeschemeMap = rule1898 _lhsItypeschemeMap + _expressionOuniqueChunk = rule1899 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule1900 _lhsIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1854 #-} + rule1854 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule1855 #-} + rule1855 = \ ((_expressionIconstraints) :: ConstraintSet) _newcon -> + _newcon .>. Node [ _expressionIconstraints ] + {-# INLINE rule1856 #-} + rule1856 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1857 #-} + rule1857 = \ _beta _cinfo ((_expressionIbeta) :: Tp) ((_lhsIimportEnvironment) :: ImportEnvironment) -> + let standard = makeScheme [] [Predicate "Num" (TVar 0)] (TVar 0 .->. TVar 0) + tpscheme = M.findWithDefault standard (nameFromString "negate") (typeEnvironment _lhsIimportEnvironment) + in [ (_expressionIbeta .->. _beta .::. tpscheme) _cinfo] + {-# INLINE rule1858 #-} + rule1858 = \ _newDEnv -> + _newDEnv + {-# INLINE rule1859 #-} + rule1859 = \ ((_rangeIself) :: Range) -> + setNameRange intUnaryMinusName _rangeIself + {-# INLINE rule1860 #-} + rule1860 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) _localName -> + case M.lookup _localName (typeEnvironment _lhsIimportEnvironment) of + Just scheme -> scheme + Nothing -> internalError "TypeInferenceOverloading.ag" "n/a" "type of negate unknown" + {-# INLINE rule1861 #-} + rule1861 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) ((_lhsIsubstitution) :: FixpointSubstitution) _negateTypeScheme _usedAsType -> + getRequiredDictionaries + (getOrderedTypeSynonyms _lhsIimportEnvironment) + (_lhsIsubstitution |-> _usedAsType) + (_lhsIsubstitution |-> _negateTypeScheme) + {-# INLINE rule1862 #-} + rule1862 = \ _beta ((_expressionIbeta) :: Tp) ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution |-> (_expressionIbeta .->. _beta) + {-# INLINE rule1863 #-} + rule1863 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) ((_lhsIavailablePredicates) :: Predicates) ((_lhsIclassEnvironment) :: ClassEnvironment) ((_lhsIsubstitution) :: FixpointSubstitution) _localName _requiredDictionaries -> + resolveOverloading (_lhsIclassEnvironment) _localName + (_lhsIsubstitution |-> _lhsIavailablePredicates) + (_lhsIsubstitution |-> _requiredDictionaries) + _expressionIdictionaryEnvironment + {-# INLINE rule1864 #-} + rule1864 = \ _localInfo _parentTree ((_rangeIself) :: Range) -> + specialConstraint "negation" _parentTree + (self _localInfo, Just $ nameToUHA_Expr (Name_Operator _rangeIself [] "-")) + [] + {-# INLINE rule1865 #-} + rule1865 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1866 #-} + rule1866 = \ ((_expressionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [_expressionIinfoTree] + {-# INLINE rule1867 #-} + rule1867 = \ _parentTree -> + _parentTree + {-# INLINE rule1868 #-} + rule1868 = \ _constraints ((_expressionIassumptions) :: Assumptions) ((_expressionImatches) :: [Maybe MetaVariableTable]) ((_expressionIuniqueSecondRound) :: Int) ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo -> + let infoTuple = metaVarInfo _constraints _expressionIassumptions _localInfo + in match1 infoTuple _expressionIuniqueSecondRound + match_Expression_Negate + _lhsItryPatterns _lhsIallPatterns + [_expressionImatches] + {-# INLINE rule1869 #-} + rule1869 = \ ((_expressionImatchIO) :: IO ()) _ioMatch -> + _expressionImatchIO >> _ioMatch + {-# INLINE rule1870 #-} + rule1870 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule1871 #-} + rule1871 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule1872 #-} + rule1872 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Negate _rangeIself _expressionIself + {-# INLINE rule1873 #-} + rule1873 = \ _self -> + _self + {-# INLINE rule1874 #-} + rule1874 = \ _beta -> + _beta + {-# INLINE rule1875 #-} + rule1875 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule1876 #-} + rule1876 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule1877 #-} + rule1877 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule1878 #-} + rule1878 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1879 #-} + rule1879 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule1880 #-} + rule1880 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule1881 #-} + rule1881 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1882 #-} + rule1882 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1883 #-} + rule1883 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1884 #-} + rule1884 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1885 #-} + rule1885 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1886 #-} + rule1886 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1887 #-} + rule1887 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1888 #-} + rule1888 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1889 #-} + rule1889 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1890 #-} + rule1890 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1891 #-} + rule1891 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1892 #-} + rule1892 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1893 #-} + rule1893 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1894 #-} + rule1894 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1895 #-} + rule1895 = \ _parentTree -> + _parentTree + {-# INLINE rule1896 #-} + rule1896 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1897 #-} + rule1897 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1898 #-} + rule1898 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1899 #-} + rule1899 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1900 #-} + rule1900 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Expression_NegateFloat #-} +sem_Expression_NegateFloat :: T_Range -> T_Expression -> T_Expression +sem_Expression_NegateFloat arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _expressionObetaUnique = rule1901 _lhsIbetaUnique + _constraints = rule1902 _expressionIconstraints _newcon + _beta = rule1903 _lhsIbetaUnique + _newcon = rule1904 _beta _cinfo _expressionIbeta + _cinfo = rule1905 _localInfo _parentTree _rangeIself + _localInfo = rule1906 _beta _lhsImonos _self + _parentTree = rule1907 _expressionIinfoTree _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule1908 _parentTree + _lhsOmatches :: [Maybe MetaVariableTable] + _lhsOconstraints :: ConstraintSet + _lhsOassumptions :: Assumptions + _lhsOuniqueSecondRound :: Int + (_expressionOtryPatterns,_lhsOmatches,_lhsOconstraints,_lhsOassumptions,_lhsOuniqueSecondRound,_ioMatch) = rule1909 _constraints _expressionIassumptions _expressionImatches _expressionIuniqueSecondRound _lhsIallPatterns _lhsItryPatterns _localInfo + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1910 _expressionImatchIO _ioMatch + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1911 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1912 _expressionIunboundNames + _self = rule1913 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1914 _self + _lhsObeta :: Tp + _lhsObeta = rule1915 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1916 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1917 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1918 _expressionIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule1919 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1920 _expressionIdictionaryEnvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1921 _expressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1922 _expressionIuniqueChunk + _expressionOallPatterns = rule1923 _lhsIallPatterns + _expressionOallTypeSchemes = rule1924 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule1925 _lhsIavailablePredicates + _expressionOclassEnvironment = rule1926 _lhsIclassEnvironment + _expressionOcollectErrors = rule1927 _lhsIcollectErrors + _expressionOcollectWarnings = rule1928 _lhsIcollectWarnings + _expressionOcounter = rule1929 _lhsIcounter + _expressionOcurrentChunk = rule1930 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule1931 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule1932 _lhsIimportEnvironment + _expressionOmatchIO = rule1933 _lhsImatchIO + _expressionOmonos = rule1934 _lhsImonos + _expressionOnamesInScope = rule1935 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule1936 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule1937 _parentTree + _expressionOpatternMatchWarnings = rule1938 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule1939 _lhsIsubstitution + _expressionOtypeschemeMap = rule1940 _lhsItypeschemeMap + _expressionOuniqueChunk = rule1941 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule1942 _lhsIuniqueSecondRound + __result_ = T_Expression_vOut40 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1901 #-} + rule1901 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule1902 #-} + rule1902 = \ ((_expressionIconstraints) :: ConstraintSet) _newcon -> + _newcon .>. Node [ _expressionIconstraints ] + {-# INLINE rule1903 #-} + rule1903 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule1904 #-} + rule1904 = \ _beta _cinfo ((_expressionIbeta) :: Tp) -> + [ (floatType .->. floatType .==. _expressionIbeta .->. _beta) _cinfo] + {-# INLINE rule1905 #-} + rule1905 = \ _localInfo _parentTree ((_rangeIself) :: Range) -> + specialConstraint "negation" _parentTree + (self _localInfo, Just $ nameToUHA_Expr (Name_Operator _rangeIself [] "-.")) + [] + {-# INLINE rule1906 #-} + rule1906 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Expr _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule1907 #-} + rule1907 = \ ((_expressionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [_expressionIinfoTree] + {-# INLINE rule1908 #-} + rule1908 = \ _parentTree -> + _parentTree + {-# INLINE rule1909 #-} + rule1909 = \ _constraints ((_expressionIassumptions) :: Assumptions) ((_expressionImatches) :: [Maybe MetaVariableTable]) ((_expressionIuniqueSecondRound) :: Int) ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) ((_lhsItryPatterns) :: [(Expression , [String])]) _localInfo -> + let infoTuple = metaVarInfo _constraints _expressionIassumptions _localInfo + in match1 infoTuple _expressionIuniqueSecondRound + match_Expression_NegateFloat + _lhsItryPatterns _lhsIallPatterns + [_expressionImatches] + {-# INLINE rule1910 #-} + rule1910 = \ ((_expressionImatchIO) :: IO ()) _ioMatch -> + _expressionImatchIO >> _ioMatch + {-# INLINE rule1911 #-} + rule1911 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule1912 #-} + rule1912 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule1913 #-} + rule1913 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NegateFloat _rangeIself _expressionIself + {-# INLINE rule1914 #-} + rule1914 = \ _self -> + _self + {-# INLINE rule1915 #-} + rule1915 = \ _beta -> + _beta + {-# INLINE rule1916 #-} + rule1916 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule1917 #-} + rule1917 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule1918 #-} + rule1918 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule1919 #-} + rule1919 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1920 #-} + rule1920 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule1921 #-} + rule1921 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule1922 #-} + rule1922 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule1923 #-} + rule1923 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1924 #-} + rule1924 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1925 #-} + rule1925 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1926 #-} + rule1926 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1927 #-} + rule1927 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1928 #-} + rule1928 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1929 #-} + rule1929 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1930 #-} + rule1930 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1931 #-} + rule1931 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1932 #-} + rule1932 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1933 #-} + rule1933 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1934 #-} + rule1934 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1935 #-} + rule1935 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1936 #-} + rule1936 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1937 #-} + rule1937 = \ _parentTree -> + _parentTree + {-# INLINE rule1938 #-} + rule1938 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1939 #-} + rule1939 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1940 #-} + rule1940 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1941 #-} + rule1941 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1942 #-} + rule1942 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + +-- Expressions ------------------------------------------------- +-- wrapper +data Inh_Expressions = Inh_Expressions { allPatterns_Inh_Expressions :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_Expressions :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_Expressions :: (Predicates), betaUnique_Inh_Expressions :: (Int), classEnvironment_Inh_Expressions :: (ClassEnvironment), collectErrors_Inh_Expressions :: (TypeErrors), collectWarnings_Inh_Expressions :: (Warnings), counter_Inh_Expressions :: (Int), currentChunk_Inh_Expressions :: (Int), dictionaryEnvironment_Inh_Expressions :: (DictionaryEnvironment), importEnvironment_Inh_Expressions :: (ImportEnvironment), matchIO_Inh_Expressions :: (IO ()), monos_Inh_Expressions :: (Monos), namesInScope_Inh_Expressions :: (Names), orderedTypeSynonyms_Inh_Expressions :: (OrderedTypeSynonyms), parentTree_Inh_Expressions :: (InfoTree), patternMatchWarnings_Inh_Expressions :: ([Warning]), substitution_Inh_Expressions :: (FixpointSubstitution), tryPatterns_Inh_Expressions :: ([(Expressions , [String])]), typeschemeMap_Inh_Expressions :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_Expressions :: (Int), uniqueSecondRound_Inh_Expressions :: (Int) } +data Syn_Expressions = Syn_Expressions { assumptions_Syn_Expressions :: (Assumptions), betaUnique_Syn_Expressions :: (Int), betas_Syn_Expressions :: (Tps), collectErrors_Syn_Expressions :: (TypeErrors), collectInstances_Syn_Expressions :: ([(Name, Instance)]), collectWarnings_Syn_Expressions :: (Warnings), constraintslist_Syn_Expressions :: (ConstraintSets), counter_Syn_Expressions :: (Int), dictionaryEnvironment_Syn_Expressions :: (DictionaryEnvironment), infoTrees_Syn_Expressions :: (InfoTrees), matchIO_Syn_Expressions :: (IO ()), matches_Syn_Expressions :: ([Maybe MetaVariableTable]), patternMatchWarnings_Syn_Expressions :: ([Warning]), self_Syn_Expressions :: (Expressions), unboundNames_Syn_Expressions :: (Names), uniqueChunk_Syn_Expressions :: (Int), uniqueSecondRound_Syn_Expressions :: (Int) } +{-# INLINABLE wrap_Expressions #-} +wrap_Expressions :: T_Expressions -> Inh_Expressions -> (Syn_Expressions ) +wrap_Expressions (T_Expressions act) (Inh_Expressions _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expressions_vIn43 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound + (T_Expressions_vOut43 _lhsOassumptions _lhsObetaUnique _lhsObetas _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) <- return (inv_Expressions_s44 sem arg) + return (Syn_Expressions _lhsOassumptions _lhsObetaUnique _lhsObetas _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) + ) + +-- cata +{-# NOINLINE sem_Expressions #-} +sem_Expressions :: Expressions -> T_Expressions +sem_Expressions list = Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list) + +-- semantic domain +newtype T_Expressions = T_Expressions { + attach_T_Expressions :: Identity (T_Expressions_s44 ) + } +newtype T_Expressions_s44 = C_Expressions_s44 { + inv_Expressions_s44 :: (T_Expressions_v43 ) + } +data T_Expressions_s45 = C_Expressions_s45 +type T_Expressions_v43 = (T_Expressions_vIn43 ) -> (T_Expressions_vOut43 ) +data T_Expressions_vIn43 = T_Expressions_vIn43 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) ([(Expressions , [String])]) (M.Map Int (Scheme Predicates)) (Int) (Int) +data T_Expressions_vOut43 = T_Expressions_vOut43 (Assumptions) (Int) (Tps) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSets) (Int) (DictionaryEnvironment) (InfoTrees) (IO ()) ([Maybe MetaVariableTable]) ([Warning]) (Expressions) (Names) (Int) (Int) +{-# NOINLINE sem_Expressions_Cons #-} +sem_Expressions_Cons :: T_Expression -> T_Expressions -> T_Expressions +sem_Expressions_Cons arg_hd_ arg_tl_ = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_hd_)) + _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_tl_)) + (T_Expression_vOut40 _hdIassumptions _hdIbeta _hdIbetaUnique _hdIcollectErrors _hdIcollectInstances _hdIcollectWarnings _hdIconstraints _hdIcounter _hdIdictionaryEnvironment _hdIinfoTree _hdImatchIO _hdImatches _hdIpatternMatchWarnings _hdIself _hdIunboundNames _hdIuniqueChunk _hdIuniqueSecondRound) = inv_Expression_s41 _hdX41 (T_Expression_vIn40 _hdOallPatterns _hdOallTypeSchemes _hdOavailablePredicates _hdObetaUnique _hdOclassEnvironment _hdOcollectErrors _hdOcollectWarnings _hdOcounter _hdOcurrentChunk _hdOdictionaryEnvironment _hdOimportEnvironment _hdOmatchIO _hdOmonos _hdOnamesInScope _hdOorderedTypeSynonyms _hdOparentTree _hdOpatternMatchWarnings _hdOsubstitution _hdOtryPatterns _hdOtypeschemeMap _hdOuniqueChunk _hdOuniqueSecondRound) + (T_Expressions_vOut43 _tlIassumptions _tlIbetaUnique _tlIbetas _tlIcollectErrors _tlIcollectInstances _tlIcollectWarnings _tlIconstraintslist _tlIcounter _tlIdictionaryEnvironment _tlIinfoTrees _tlImatchIO _tlImatches _tlIpatternMatchWarnings _tlIself _tlIunboundNames _tlIuniqueChunk _tlIuniqueSecondRound) = inv_Expressions_s44 _tlX44 (T_Expressions_vIn43 _tlOallPatterns _tlOallTypeSchemes _tlOavailablePredicates _tlObetaUnique _tlOclassEnvironment _tlOcollectErrors _tlOcollectWarnings _tlOcounter _tlOcurrentChunk _tlOdictionaryEnvironment _tlOimportEnvironment _tlOmatchIO _tlOmonos _tlOnamesInScope _tlOorderedTypeSynonyms _tlOparentTree _tlOpatternMatchWarnings _tlOsubstitution _tlOtryPatterns _tlOtypeschemeMap _tlOuniqueChunk _tlOuniqueSecondRound) + _lhsObetas :: Tps + _lhsObetas = rule1943 _hdIbeta _tlIbetas + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule1944 _hdIassumptions _tlIassumptions + _lhsOconstraintslist :: ConstraintSets + _lhsOconstraintslist = rule1945 _hdIconstraints _tlIconstraintslist + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule1946 _hdIinfoTree _tlIinfoTrees + _lhsOmatches :: [Maybe MetaVariableTable] + ((_hdOtryPatterns,_tlOtryPatterns),_lhsOmatches,_,_,_,_) = rule1947 _hdImatches _lhsItryPatterns _tlImatches + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1948 _hdIcollectInstances _tlIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1949 _hdIunboundNames _tlIunboundNames + _self = rule1950 _hdIself _tlIself + _lhsOself :: Expressions + _lhsOself = rule1951 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule1952 _tlIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule1953 _tlIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule1954 _tlIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule1955 _tlIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule1956 _tlIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule1957 _tlImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule1958 _tlIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule1959 _tlIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule1960 _tlIuniqueSecondRound + _hdOallPatterns = rule1961 _lhsIallPatterns + _hdOallTypeSchemes = rule1962 _lhsIallTypeSchemes + _hdOavailablePredicates = rule1963 _lhsIavailablePredicates + _hdObetaUnique = rule1964 _lhsIbetaUnique + _hdOclassEnvironment = rule1965 _lhsIclassEnvironment + _hdOcollectErrors = rule1966 _lhsIcollectErrors + _hdOcollectWarnings = rule1967 _lhsIcollectWarnings + _hdOcounter = rule1968 _lhsIcounter + _hdOcurrentChunk = rule1969 _lhsIcurrentChunk + _hdOdictionaryEnvironment = rule1970 _lhsIdictionaryEnvironment + _hdOimportEnvironment = rule1971 _lhsIimportEnvironment + _hdOmatchIO = rule1972 _lhsImatchIO + _hdOmonos = rule1973 _lhsImonos + _hdOnamesInScope = rule1974 _lhsInamesInScope + _hdOorderedTypeSynonyms = rule1975 _lhsIorderedTypeSynonyms + _hdOparentTree = rule1976 _lhsIparentTree + _hdOpatternMatchWarnings = rule1977 _lhsIpatternMatchWarnings + _hdOsubstitution = rule1978 _lhsIsubstitution + _hdOtypeschemeMap = rule1979 _lhsItypeschemeMap + _hdOuniqueChunk = rule1980 _lhsIuniqueChunk + _hdOuniqueSecondRound = rule1981 _lhsIuniqueSecondRound + _tlOallPatterns = rule1982 _lhsIallPatterns + _tlOallTypeSchemes = rule1983 _lhsIallTypeSchemes + _tlOavailablePredicates = rule1984 _lhsIavailablePredicates + _tlObetaUnique = rule1985 _hdIbetaUnique + _tlOclassEnvironment = rule1986 _lhsIclassEnvironment + _tlOcollectErrors = rule1987 _hdIcollectErrors + _tlOcollectWarnings = rule1988 _hdIcollectWarnings + _tlOcounter = rule1989 _hdIcounter + _tlOcurrentChunk = rule1990 _lhsIcurrentChunk + _tlOdictionaryEnvironment = rule1991 _hdIdictionaryEnvironment + _tlOimportEnvironment = rule1992 _lhsIimportEnvironment + _tlOmatchIO = rule1993 _hdImatchIO + _tlOmonos = rule1994 _lhsImonos + _tlOnamesInScope = rule1995 _lhsInamesInScope + _tlOorderedTypeSynonyms = rule1996 _lhsIorderedTypeSynonyms + _tlOparentTree = rule1997 _lhsIparentTree + _tlOpatternMatchWarnings = rule1998 _hdIpatternMatchWarnings + _tlOsubstitution = rule1999 _lhsIsubstitution + _tlOtypeschemeMap = rule2000 _lhsItypeschemeMap + _tlOuniqueChunk = rule2001 _hdIuniqueChunk + _tlOuniqueSecondRound = rule2002 _hdIuniqueSecondRound + __result_ = T_Expressions_vOut43 _lhsOassumptions _lhsObetaUnique _lhsObetas _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule1943 #-} + rule1943 = \ ((_hdIbeta) :: Tp) ((_tlIbetas) :: Tps) -> + _hdIbeta : _tlIbetas + {-# INLINE rule1944 #-} + rule1944 = \ ((_hdIassumptions) :: Assumptions) ((_tlIassumptions) :: Assumptions) -> + _hdIassumptions `combine` _tlIassumptions + {-# INLINE rule1945 #-} + rule1945 = \ ((_hdIconstraints) :: ConstraintSet) ((_tlIconstraintslist) :: ConstraintSets) -> + _hdIconstraints : _tlIconstraintslist + {-# INLINE rule1946 #-} + rule1946 = \ ((_hdIinfoTree) :: InfoTree) ((_tlIinfoTrees) :: InfoTrees) -> + _hdIinfoTree : _tlIinfoTrees + {-# INLINE rule1947 #-} + rule1947 = \ ((_hdImatches) :: [Maybe MetaVariableTable]) ((_lhsItryPatterns) :: [(Expressions , [String])]) ((_tlImatches) :: [Maybe MetaVariableTable]) -> + match2' match_Expressions_Cons _lhsItryPatterns [] [_hdImatches, _tlImatches] + {-# INLINE rule1948 #-} + rule1948 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule1949 #-} + rule1949 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule1950 #-} + rule1950 = \ ((_hdIself) :: Expression) ((_tlIself) :: Expressions) -> + (:) _hdIself _tlIself + {-# INLINE rule1951 #-} + rule1951 = \ _self -> + _self + {-# INLINE rule1952 #-} + rule1952 = \ ((_tlIbetaUnique) :: Int) -> + _tlIbetaUnique + {-# INLINE rule1953 #-} + rule1953 = \ ((_tlIcollectErrors) :: TypeErrors) -> + _tlIcollectErrors + {-# INLINE rule1954 #-} + rule1954 = \ ((_tlIcollectWarnings) :: Warnings) -> + _tlIcollectWarnings + {-# INLINE rule1955 #-} + rule1955 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule1956 #-} + rule1956 = \ ((_tlIdictionaryEnvironment) :: DictionaryEnvironment) -> + _tlIdictionaryEnvironment + {-# INLINE rule1957 #-} + rule1957 = \ ((_tlImatchIO) :: IO ()) -> + _tlImatchIO + {-# INLINE rule1958 #-} + rule1958 = \ ((_tlIpatternMatchWarnings) :: [Warning]) -> + _tlIpatternMatchWarnings + {-# INLINE rule1959 #-} + rule1959 = \ ((_tlIuniqueChunk) :: Int) -> + _tlIuniqueChunk + {-# INLINE rule1960 #-} + rule1960 = \ ((_tlIuniqueSecondRound) :: Int) -> + _tlIuniqueSecondRound + {-# INLINE rule1961 #-} + rule1961 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1962 #-} + rule1962 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1963 #-} + rule1963 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1964 #-} + rule1964 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule1965 #-} + rule1965 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1966 #-} + rule1966 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule1967 #-} + rule1967 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule1968 #-} + rule1968 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1969 #-} + rule1969 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1970 #-} + rule1970 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule1971 #-} + rule1971 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1972 #-} + rule1972 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule1973 #-} + rule1973 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1974 #-} + rule1974 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1975 #-} + rule1975 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1976 #-} + rule1976 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule1977 #-} + rule1977 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule1978 #-} + rule1978 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule1979 #-} + rule1979 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule1980 #-} + rule1980 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule1981 #-} + rule1981 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule1982 #-} + rule1982 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule1983 #-} + rule1983 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule1984 #-} + rule1984 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule1985 #-} + rule1985 = \ ((_hdIbetaUnique) :: Int) -> + _hdIbetaUnique + {-# INLINE rule1986 #-} + rule1986 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1987 #-} + rule1987 = \ ((_hdIcollectErrors) :: TypeErrors) -> + _hdIcollectErrors + {-# INLINE rule1988 #-} + rule1988 = \ ((_hdIcollectWarnings) :: Warnings) -> + _hdIcollectWarnings + {-# INLINE rule1989 #-} + rule1989 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule1990 #-} + rule1990 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule1991 #-} + rule1991 = \ ((_hdIdictionaryEnvironment) :: DictionaryEnvironment) -> + _hdIdictionaryEnvironment + {-# INLINE rule1992 #-} + rule1992 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule1993 #-} + rule1993 = \ ((_hdImatchIO) :: IO ()) -> + _hdImatchIO + {-# INLINE rule1994 #-} + rule1994 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule1995 #-} + rule1995 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1996 #-} + rule1996 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1997 #-} + rule1997 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule1998 #-} + rule1998 = \ ((_hdIpatternMatchWarnings) :: [Warning]) -> + _hdIpatternMatchWarnings + {-# INLINE rule1999 #-} + rule1999 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule2000 #-} + rule2000 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule2001 #-} + rule2001 = \ ((_hdIuniqueChunk) :: Int) -> + _hdIuniqueChunk + {-# INLINE rule2002 #-} + rule2002 = \ ((_hdIuniqueSecondRound) :: Int) -> + _hdIuniqueSecondRound +{-# NOINLINE sem_Expressions_Nil #-} +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _lhsObetas :: Tps + _lhsObetas = rule2003 () + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2004 () + _lhsOconstraintslist :: ConstraintSets + _lhsOconstraintslist = rule2005 () + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2006 () + _lhsOmatches :: [Maybe MetaVariableTable] + ((),_lhsOmatches,_,_,_,_) = rule2007 _lhsItryPatterns + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2008 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2009 () + _self = rule2010 () + _lhsOself :: Expressions + _lhsOself = rule2011 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2012 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2013 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2014 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule2015 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2016 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2017 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2018 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2019 _lhsIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule2020 _lhsIuniqueSecondRound + __result_ = T_Expressions_vOut43 _lhsOassumptions _lhsObetaUnique _lhsObetas _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule2003 #-} + rule2003 = \ (_ :: ()) -> + [] + {-# INLINE rule2004 #-} + rule2004 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule2005 #-} + rule2005 = \ (_ :: ()) -> + [] + {-# INLINE rule2006 #-} + rule2006 = \ (_ :: ()) -> + [] + {-# INLINE rule2007 #-} + rule2007 = \ ((_lhsItryPatterns) :: [(Expressions , [String])]) -> + match0' match_Expressions_Nil _lhsItryPatterns [] [] + {-# INLINE rule2008 #-} + rule2008 = \ (_ :: ()) -> + [] + {-# INLINE rule2009 #-} + rule2009 = \ (_ :: ()) -> + [] + {-# INLINE rule2010 #-} + rule2010 = \ (_ :: ()) -> + [] + {-# INLINE rule2011 #-} + rule2011 = \ _self -> + _self + {-# INLINE rule2012 #-} + rule2012 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2013 #-} + rule2013 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2014 #-} + rule2014 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2015 #-} + rule2015 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2016 #-} + rule2016 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2017 #-} + rule2017 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2018 #-} + rule2018 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2019 #-} + rule2019 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule2020 #-} + rule2020 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + +-- FieldDeclaration -------------------------------------------- +-- wrapper +data Inh_FieldDeclaration = Inh_FieldDeclaration { counter_Inh_FieldDeclaration :: (Int), namesInScope_Inh_FieldDeclaration :: (Names) } +data Syn_FieldDeclaration = Syn_FieldDeclaration { counter_Syn_FieldDeclaration :: (Int), self_Syn_FieldDeclaration :: (FieldDeclaration), unboundNames_Syn_FieldDeclaration :: (Names) } +{-# INLINABLE wrap_FieldDeclaration #-} +wrap_FieldDeclaration :: T_FieldDeclaration -> Inh_FieldDeclaration -> (Syn_FieldDeclaration ) +wrap_FieldDeclaration (T_FieldDeclaration act) (Inh_FieldDeclaration _lhsIcounter _lhsInamesInScope) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclaration_vIn46 _lhsIcounter _lhsInamesInScope + (T_FieldDeclaration_vOut46 _lhsOcounter _lhsOself _lhsOunboundNames) <- return (inv_FieldDeclaration_s47 sem arg) + return (Syn_FieldDeclaration _lhsOcounter _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# INLINE sem_FieldDeclaration #-} +sem_FieldDeclaration :: FieldDeclaration -> T_FieldDeclaration +sem_FieldDeclaration ( FieldDeclaration_FieldDeclaration range_ names_ type_ ) = sem_FieldDeclaration_FieldDeclaration ( sem_Range range_ ) ( sem_Names names_ ) ( sem_AnnotatedType type_ ) + +-- semantic domain +newtype T_FieldDeclaration = T_FieldDeclaration { + attach_T_FieldDeclaration :: Identity (T_FieldDeclaration_s47 ) + } +newtype T_FieldDeclaration_s47 = C_FieldDeclaration_s47 { + inv_FieldDeclaration_s47 :: (T_FieldDeclaration_v46 ) + } +data T_FieldDeclaration_s48 = C_FieldDeclaration_s48 +type T_FieldDeclaration_v46 = (T_FieldDeclaration_vIn46 ) -> (T_FieldDeclaration_vOut46 ) +data T_FieldDeclaration_vIn46 = T_FieldDeclaration_vIn46 (Int) (Names) +data T_FieldDeclaration_vOut46 = T_FieldDeclaration_vOut46 (Int) (FieldDeclaration) (Names) +{-# NOINLINE sem_FieldDeclaration_FieldDeclaration #-} +sem_FieldDeclaration_FieldDeclaration :: T_Range -> T_Names -> T_AnnotatedType -> T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration arg_range_ arg_names_ arg_type_ = T_FieldDeclaration (return st47) where + {-# NOINLINE st47 #-} + st47 = let + v46 :: T_FieldDeclaration_v46 + v46 = \ (T_FieldDeclaration_vIn46 _lhsIcounter _lhsInamesInScope) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_AnnotatedType_vOut7 _typeIcounter _typeIself _typeIunboundNames) = inv_AnnotatedType_s8 _typeX8 (T_AnnotatedType_vIn7 _typeOcounter _typeOnamesInScope) + (_kindErrors,_tyconEnv,_constructorenv,_importEnvironment,_valueConstructors,_allValueConstructors,_typeConstructors,_allTypeConstructors,_warnings) = rule2021 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2022 _typeIunboundNames + _self = rule2023 _namesIself _rangeIself _typeIself + _lhsOself :: FieldDeclaration + _lhsOself = rule2024 _self + _lhsOcounter :: Int + _lhsOcounter = rule2025 _typeIcounter + _typeOcounter = rule2026 _lhsIcounter + _typeOnamesInScope = rule2027 _lhsInamesInScope + __result_ = T_FieldDeclaration_vOut46 _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_FieldDeclaration_s47 v46 + {-# INLINE rule2021 #-} + rule2021 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "FieldDeclaration.FieldDeclaration" + {-# INLINE rule2022 #-} + rule2022 = \ ((_typeIunboundNames) :: Names) -> + _typeIunboundNames + {-# INLINE rule2023 #-} + rule2023 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: AnnotatedType) -> + FieldDeclaration_FieldDeclaration _rangeIself _namesIself _typeIself + {-# INLINE rule2024 #-} + rule2024 = \ _self -> + _self + {-# INLINE rule2025 #-} + rule2025 = \ ((_typeIcounter) :: Int) -> + _typeIcounter + {-# INLINE rule2026 #-} + rule2026 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2027 #-} + rule2027 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + +-- FieldDeclarations ------------------------------------------- +-- wrapper +data Inh_FieldDeclarations = Inh_FieldDeclarations { counter_Inh_FieldDeclarations :: (Int), namesInScope_Inh_FieldDeclarations :: (Names) } +data Syn_FieldDeclarations = Syn_FieldDeclarations { counter_Syn_FieldDeclarations :: (Int), self_Syn_FieldDeclarations :: (FieldDeclarations), unboundNames_Syn_FieldDeclarations :: (Names) } +{-# INLINABLE wrap_FieldDeclarations #-} +wrap_FieldDeclarations :: T_FieldDeclarations -> Inh_FieldDeclarations -> (Syn_FieldDeclarations ) +wrap_FieldDeclarations (T_FieldDeclarations act) (Inh_FieldDeclarations _lhsIcounter _lhsInamesInScope) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclarations_vIn49 _lhsIcounter _lhsInamesInScope + (T_FieldDeclarations_vOut49 _lhsOcounter _lhsOself _lhsOunboundNames) <- return (inv_FieldDeclarations_s50 sem arg) + return (Syn_FieldDeclarations _lhsOcounter _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_FieldDeclarations #-} +sem_FieldDeclarations :: FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations list = Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list) + +-- semantic domain +newtype T_FieldDeclarations = T_FieldDeclarations { + attach_T_FieldDeclarations :: Identity (T_FieldDeclarations_s50 ) + } +newtype T_FieldDeclarations_s50 = C_FieldDeclarations_s50 { + inv_FieldDeclarations_s50 :: (T_FieldDeclarations_v49 ) + } +data T_FieldDeclarations_s51 = C_FieldDeclarations_s51 +type T_FieldDeclarations_v49 = (T_FieldDeclarations_vIn49 ) -> (T_FieldDeclarations_vOut49 ) +data T_FieldDeclarations_vIn49 = T_FieldDeclarations_vIn49 (Int) (Names) +data T_FieldDeclarations_vOut49 = T_FieldDeclarations_vOut49 (Int) (FieldDeclarations) (Names) +{-# NOINLINE sem_FieldDeclarations_Cons #-} +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> T_FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations_Cons arg_hd_ arg_tl_ = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 _lhsIcounter _lhsInamesInScope) -> ( let + _hdX47 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclaration (arg_hd_)) + _tlX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_tl_)) + (T_FieldDeclaration_vOut46 _hdIcounter _hdIself _hdIunboundNames) = inv_FieldDeclaration_s47 _hdX47 (T_FieldDeclaration_vIn46 _hdOcounter _hdOnamesInScope) + (T_FieldDeclarations_vOut49 _tlIcounter _tlIself _tlIunboundNames) = inv_FieldDeclarations_s50 _tlX50 (T_FieldDeclarations_vIn49 _tlOcounter _tlOnamesInScope) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2028 _hdIunboundNames _tlIunboundNames + _self = rule2029 _hdIself _tlIself + _lhsOself :: FieldDeclarations + _lhsOself = rule2030 _self + _lhsOcounter :: Int + _lhsOcounter = rule2031 _tlIcounter + _hdOcounter = rule2032 _lhsIcounter + _hdOnamesInScope = rule2033 _lhsInamesInScope + _tlOcounter = rule2034 _hdIcounter + _tlOnamesInScope = rule2035 _lhsInamesInScope + __result_ = T_FieldDeclarations_vOut49 _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule2028 #-} + rule2028 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule2029 #-} + rule2029 = \ ((_hdIself) :: FieldDeclaration) ((_tlIself) :: FieldDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule2030 #-} + rule2030 = \ _self -> + _self + {-# INLINE rule2031 #-} + rule2031 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule2032 #-} + rule2032 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2033 #-} + rule2033 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2034 #-} + rule2034 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule2035 #-} + rule2035 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope +{-# NOINLINE sem_FieldDeclarations_Nil #-} +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 _lhsIcounter _lhsInamesInScope) -> ( let + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2036 () + _self = rule2037 () + _lhsOself :: FieldDeclarations + _lhsOself = rule2038 _self + _lhsOcounter :: Int + _lhsOcounter = rule2039 _lhsIcounter + __result_ = T_FieldDeclarations_vOut49 _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule2036 #-} + rule2036 = \ (_ :: ()) -> + [] + {-# INLINE rule2037 #-} + rule2037 = \ (_ :: ()) -> + [] + {-# INLINE rule2038 #-} + rule2038 = \ _self -> + _self + {-# INLINE rule2039 #-} + rule2039 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + +-- Fixity ------------------------------------------------------ +-- wrapper +data Inh_Fixity = Inh_Fixity { } +data Syn_Fixity = Syn_Fixity { self_Syn_Fixity :: (Fixity) } +{-# INLINABLE wrap_Fixity #-} +wrap_Fixity :: T_Fixity -> Inh_Fixity -> (Syn_Fixity ) +wrap_Fixity (T_Fixity act) (Inh_Fixity ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Fixity_vIn52 + (T_Fixity_vOut52 _lhsOself) <- return (inv_Fixity_s53 sem arg) + return (Syn_Fixity _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Fixity #-} +sem_Fixity :: Fixity -> T_Fixity +sem_Fixity ( Fixity_Infixl range_ ) = sem_Fixity_Infixl ( sem_Range range_ ) +sem_Fixity ( Fixity_Infixr range_ ) = sem_Fixity_Infixr ( sem_Range range_ ) +sem_Fixity ( Fixity_Infix range_ ) = sem_Fixity_Infix ( sem_Range range_ ) + +-- semantic domain +newtype T_Fixity = T_Fixity { + attach_T_Fixity :: Identity (T_Fixity_s53 ) + } +newtype T_Fixity_s53 = C_Fixity_s53 { + inv_Fixity_s53 :: (T_Fixity_v52 ) + } +data T_Fixity_s54 = C_Fixity_s54 +type T_Fixity_v52 = (T_Fixity_vIn52 ) -> (T_Fixity_vOut52 ) +data T_Fixity_vIn52 = T_Fixity_vIn52 +data T_Fixity_vOut52 = T_Fixity_vOut52 (Fixity) +{-# NOINLINE sem_Fixity_Infixl #-} +sem_Fixity_Infixl :: T_Range -> T_Fixity +sem_Fixity_Infixl arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule2040 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule2041 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule2040 #-} + rule2040 = \ ((_rangeIself) :: Range) -> + Fixity_Infixl _rangeIself + {-# INLINE rule2041 #-} + rule2041 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infixr #-} +sem_Fixity_Infixr :: T_Range -> T_Fixity +sem_Fixity_Infixr arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule2042 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule2043 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule2042 #-} + rule2042 = \ ((_rangeIself) :: Range) -> + Fixity_Infixr _rangeIself + {-# INLINE rule2043 #-} + rule2043 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infix #-} +sem_Fixity_Infix :: T_Range -> T_Fixity +sem_Fixity_Infix arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule2044 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule2045 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule2044 #-} + rule2044 = \ ((_rangeIself) :: Range) -> + Fixity_Infix _rangeIself + {-# INLINE rule2045 #-} + rule2045 = \ _self -> + _self + +-- FunctionBinding --------------------------------------------- +-- wrapper +data Inh_FunctionBinding = Inh_FunctionBinding { allPatterns_Inh_FunctionBinding :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_FunctionBinding :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_FunctionBinding :: (Predicates), betaRight_Inh_FunctionBinding :: (Tp), betaUnique_Inh_FunctionBinding :: (Int), betasLeft_Inh_FunctionBinding :: (Tps), classEnvironment_Inh_FunctionBinding :: (ClassEnvironment), collectErrors_Inh_FunctionBinding :: (TypeErrors), collectWarnings_Inh_FunctionBinding :: (Warnings), counter_Inh_FunctionBinding :: (Int), currentChunk_Inh_FunctionBinding :: (Int), dictionaryEnvironment_Inh_FunctionBinding :: (DictionaryEnvironment), importEnvironment_Inh_FunctionBinding :: (ImportEnvironment), matchIO_Inh_FunctionBinding :: (IO ()), monos_Inh_FunctionBinding :: (Monos), namesInScope_Inh_FunctionBinding :: (Names), orderedTypeSynonyms_Inh_FunctionBinding :: (OrderedTypeSynonyms), parentTree_Inh_FunctionBinding :: (InfoTree), patternMatchWarnings_Inh_FunctionBinding :: ([Warning]), substitution_Inh_FunctionBinding :: (FixpointSubstitution), typeschemeMap_Inh_FunctionBinding :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_FunctionBinding :: (Int) } +data Syn_FunctionBinding = Syn_FunctionBinding { argcount_Syn_FunctionBinding :: (Int), assumptions_Syn_FunctionBinding :: (Assumptions), betaUnique_Syn_FunctionBinding :: (Int), collectErrors_Syn_FunctionBinding :: (TypeErrors), collectInstances_Syn_FunctionBinding :: ([(Name, Instance)]), collectWarnings_Syn_FunctionBinding :: (Warnings), constraints_Syn_FunctionBinding :: (ConstraintSet), counter_Syn_FunctionBinding :: (Int), dictionaryEnvironment_Syn_FunctionBinding :: (DictionaryEnvironment), elements_Syn_FunctionBinding :: ( ([PatternElement], Bool) ), infoTree_Syn_FunctionBinding :: (InfoTree), matchIO_Syn_FunctionBinding :: (IO ()), name_Syn_FunctionBinding :: (Name), numberOfPatterns_Syn_FunctionBinding :: (Int), patternMatchWarnings_Syn_FunctionBinding :: ([Warning]), self_Syn_FunctionBinding :: (FunctionBinding), unboundNames_Syn_FunctionBinding :: (Names), uniqueChunk_Syn_FunctionBinding :: (Int), unrwar_Syn_FunctionBinding :: (Warning) } +{-# INLINABLE wrap_FunctionBinding #-} +wrap_FunctionBinding :: T_FunctionBinding -> Inh_FunctionBinding -> (Syn_FunctionBinding ) +wrap_FunctionBinding (T_FunctionBinding act) (Inh_FunctionBinding _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIbetasLeft _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBinding_vIn55 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIbetasLeft _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk + (T_FunctionBinding_vOut55 _lhsOargcount _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOelements _lhsOinfoTree _lhsOmatchIO _lhsOname _lhsOnumberOfPatterns _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwar) <- return (inv_FunctionBinding_s56 sem arg) + return (Syn_FunctionBinding _lhsOargcount _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOelements _lhsOinfoTree _lhsOmatchIO _lhsOname _lhsOnumberOfPatterns _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwar) + ) + +-- cata +{-# NOINLINE sem_FunctionBinding #-} +sem_FunctionBinding :: FunctionBinding -> T_FunctionBinding +sem_FunctionBinding ( FunctionBinding_Hole range_ id_ ) = sem_FunctionBinding_Hole ( sem_Range range_ ) id_ +sem_FunctionBinding ( FunctionBinding_Feedback range_ feedback_ functionBinding_ ) = sem_FunctionBinding_Feedback ( sem_Range range_ ) feedback_ ( sem_FunctionBinding functionBinding_ ) +sem_FunctionBinding ( FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ ) = sem_FunctionBinding_FunctionBinding ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_RightHandSide righthandside_ ) + +-- semantic domain +newtype T_FunctionBinding = T_FunctionBinding { + attach_T_FunctionBinding :: Identity (T_FunctionBinding_s56 ) + } +newtype T_FunctionBinding_s56 = C_FunctionBinding_s56 { + inv_FunctionBinding_s56 :: (T_FunctionBinding_v55 ) + } +data T_FunctionBinding_s57 = C_FunctionBinding_s57 +type T_FunctionBinding_v55 = (T_FunctionBinding_vIn55 ) -> (T_FunctionBinding_vOut55 ) +data T_FunctionBinding_vIn55 = T_FunctionBinding_vIn55 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Tp) (Int) (Tps) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Int) +data T_FunctionBinding_vOut55 = T_FunctionBinding_vOut55 (Int) (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (DictionaryEnvironment) ( ([PatternElement], Bool) ) (InfoTree) (IO ()) (Name) (Int) ([Warning]) (FunctionBinding) (Names) (Int) (Warning) +{-# NOINLINE sem_FunctionBinding_Hole #-} +sem_FunctionBinding_Hole :: T_Range -> (Integer) -> T_FunctionBinding +sem_FunctionBinding_Hole arg_range_ arg_id_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIbetasLeft _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _assumptions = rule2046 () + _constraints = rule2047 () + _numberOfPatterns = rule2048 () + _name = rule2049 () + _localInfo = rule2050 _lhsImonos _self + _parentTree = rule2051 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2052 _parentTree + _lhsOargcount :: Int + _lhsOargcount = rule2053 () + _lhsOelements :: ([PatternElement], Bool) + _lhsOelements = rule2054 () + _lhsOunrwar :: Warning + _lhsOunrwar = rule2055 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2056 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2057 () + _self = rule2058 _rangeIself arg_id_ + _lhsOself :: FunctionBinding + _lhsOself = rule2059 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2060 _assumptions + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2061 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2062 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2063 _lhsIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2064 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2065 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2066 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2067 _lhsImatchIO + _lhsOname :: Name + _lhsOname = rule2068 _name + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule2069 _numberOfPatterns + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2070 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2071 _lhsIuniqueChunk + __result_ = T_FunctionBinding_vOut55 _lhsOargcount _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOelements _lhsOinfoTree _lhsOmatchIO _lhsOname _lhsOnumberOfPatterns _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwar + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule2046 #-} + rule2046 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule2047 #-} + rule2047 = \ (_ :: ()) -> + emptyTree + {-# INLINE rule2048 #-} + rule2048 = \ (_ :: ()) -> + 0 + {-# INLINE rule2049 #-} + rule2049 = \ (_ :: ()) -> + internalError "TypeInferencing.ag" "n/a" "FunctionBindings(2)" + {-# INLINE rule2050 #-} + rule2050 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_FB _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule2051 #-} + rule2051 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule2052 #-} + rule2052 = \ _parentTree -> + _parentTree + {-# INLINE rule2053 #-} + rule2053 = \ (_ :: ()) -> + 0 + {-# INLINE rule2054 #-} + rule2054 = \ (_ :: ()) -> + ([], False) + {-# INLINE rule2055 #-} + rule2055 = \ (_ :: ()) -> + pmError "FunctionBinding_Hole.unrwar" "hole unrwar" + {-# INLINE rule2056 #-} + rule2056 = \ (_ :: ()) -> + [] + {-# INLINE rule2057 #-} + rule2057 = \ (_ :: ()) -> + [] + {-# INLINE rule2058 #-} + rule2058 = \ ((_rangeIself) :: Range) id_ -> + FunctionBinding_Hole _rangeIself id_ + {-# INLINE rule2059 #-} + rule2059 = \ _self -> + _self + {-# INLINE rule2060 #-} + rule2060 = \ _assumptions -> + _assumptions + {-# INLINE rule2061 #-} + rule2061 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2062 #-} + rule2062 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2063 #-} + rule2063 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2064 #-} + rule2064 = \ _constraints -> + _constraints + {-# INLINE rule2065 #-} + rule2065 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2066 #-} + rule2066 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2067 #-} + rule2067 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2068 #-} + rule2068 = \ _name -> + _name + {-# INLINE rule2069 #-} + rule2069 = \ _numberOfPatterns -> + _numberOfPatterns + {-# INLINE rule2070 #-} + rule2070 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2071 #-} + rule2071 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_FunctionBinding_Feedback #-} +sem_FunctionBinding_Feedback :: T_Range -> (String) -> T_FunctionBinding -> T_FunctionBinding +sem_FunctionBinding_Feedback arg_range_ arg_feedback_ arg_functionBinding_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIbetasLeft _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionBindingX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_functionBinding_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBinding_vOut55 _functionBindingIargcount _functionBindingIassumptions _functionBindingIbetaUnique _functionBindingIcollectErrors _functionBindingIcollectInstances _functionBindingIcollectWarnings _functionBindingIconstraints _functionBindingIcounter _functionBindingIdictionaryEnvironment _functionBindingIelements _functionBindingIinfoTree _functionBindingImatchIO _functionBindingIname _functionBindingInumberOfPatterns _functionBindingIpatternMatchWarnings _functionBindingIself _functionBindingIunboundNames _functionBindingIuniqueChunk _functionBindingIunrwar) = inv_FunctionBinding_s56 _functionBindingX56 (T_FunctionBinding_vIn55 _functionBindingOallPatterns _functionBindingOallTypeSchemes _functionBindingOavailablePredicates _functionBindingObetaRight _functionBindingObetaUnique _functionBindingObetasLeft _functionBindingOclassEnvironment _functionBindingOcollectErrors _functionBindingOcollectWarnings _functionBindingOcounter _functionBindingOcurrentChunk _functionBindingOdictionaryEnvironment _functionBindingOimportEnvironment _functionBindingOmatchIO _functionBindingOmonos _functionBindingOnamesInScope _functionBindingOorderedTypeSynonyms _functionBindingOparentTree _functionBindingOpatternMatchWarnings _functionBindingOsubstitution _functionBindingOtypeschemeMap _functionBindingOuniqueChunk) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2072 _functionBindingIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2073 _functionBindingIunboundNames + _self = rule2074 _functionBindingIself _rangeIself arg_feedback_ + _lhsOself :: FunctionBinding + _lhsOself = rule2075 _self + _lhsOargcount :: Int + _lhsOargcount = rule2076 _functionBindingIargcount + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2077 _functionBindingIassumptions + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2078 _functionBindingIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2079 _functionBindingIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2080 _functionBindingIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2081 _functionBindingIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule2082 _functionBindingIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2083 _functionBindingIdictionaryEnvironment + _lhsOelements :: ([PatternElement], Bool) + _lhsOelements = rule2084 _functionBindingIelements + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2085 _functionBindingIinfoTree + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2086 _functionBindingImatchIO + _lhsOname :: Name + _lhsOname = rule2087 _functionBindingIname + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule2088 _functionBindingInumberOfPatterns + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2089 _functionBindingIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2090 _functionBindingIuniqueChunk + _lhsOunrwar :: Warning + _lhsOunrwar = rule2091 _functionBindingIunrwar + _functionBindingOallPatterns = rule2092 _lhsIallPatterns + _functionBindingOallTypeSchemes = rule2093 _lhsIallTypeSchemes + _functionBindingOavailablePredicates = rule2094 _lhsIavailablePredicates + _functionBindingObetaRight = rule2095 _lhsIbetaRight + _functionBindingObetaUnique = rule2096 _lhsIbetaUnique + _functionBindingObetasLeft = rule2097 _lhsIbetasLeft + _functionBindingOclassEnvironment = rule2098 _lhsIclassEnvironment + _functionBindingOcollectErrors = rule2099 _lhsIcollectErrors + _functionBindingOcollectWarnings = rule2100 _lhsIcollectWarnings + _functionBindingOcounter = rule2101 _lhsIcounter + _functionBindingOcurrentChunk = rule2102 _lhsIcurrentChunk + _functionBindingOdictionaryEnvironment = rule2103 _lhsIdictionaryEnvironment + _functionBindingOimportEnvironment = rule2104 _lhsIimportEnvironment + _functionBindingOmatchIO = rule2105 _lhsImatchIO + _functionBindingOmonos = rule2106 _lhsImonos + _functionBindingOnamesInScope = rule2107 _lhsInamesInScope + _functionBindingOorderedTypeSynonyms = rule2108 _lhsIorderedTypeSynonyms + _functionBindingOparentTree = rule2109 _lhsIparentTree + _functionBindingOpatternMatchWarnings = rule2110 _lhsIpatternMatchWarnings + _functionBindingOsubstitution = rule2111 _lhsIsubstitution + _functionBindingOtypeschemeMap = rule2112 _lhsItypeschemeMap + _functionBindingOuniqueChunk = rule2113 _lhsIuniqueChunk + __result_ = T_FunctionBinding_vOut55 _lhsOargcount _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOelements _lhsOinfoTree _lhsOmatchIO _lhsOname _lhsOnumberOfPatterns _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwar + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule2072 #-} + rule2072 = \ ((_functionBindingIcollectInstances) :: [(Name, Instance)]) -> + _functionBindingIcollectInstances + {-# INLINE rule2073 #-} + rule2073 = \ ((_functionBindingIunboundNames) :: Names) -> + _functionBindingIunboundNames + {-# INLINE rule2074 #-} + rule2074 = \ ((_functionBindingIself) :: FunctionBinding) ((_rangeIself) :: Range) feedback_ -> + FunctionBinding_Feedback _rangeIself feedback_ _functionBindingIself + {-# INLINE rule2075 #-} + rule2075 = \ _self -> + _self + {-# INLINE rule2076 #-} + rule2076 = \ ((_functionBindingIargcount) :: Int) -> + _functionBindingIargcount + {-# INLINE rule2077 #-} + rule2077 = \ ((_functionBindingIassumptions) :: Assumptions) -> + _functionBindingIassumptions + {-# INLINE rule2078 #-} + rule2078 = \ ((_functionBindingIbetaUnique) :: Int) -> + _functionBindingIbetaUnique + {-# INLINE rule2079 #-} + rule2079 = \ ((_functionBindingIcollectErrors) :: TypeErrors) -> + _functionBindingIcollectErrors + {-# INLINE rule2080 #-} + rule2080 = \ ((_functionBindingIcollectWarnings) :: Warnings) -> + _functionBindingIcollectWarnings + {-# INLINE rule2081 #-} + rule2081 = \ ((_functionBindingIconstraints) :: ConstraintSet) -> + _functionBindingIconstraints + {-# INLINE rule2082 #-} + rule2082 = \ ((_functionBindingIcounter) :: Int) -> + _functionBindingIcounter + {-# INLINE rule2083 #-} + rule2083 = \ ((_functionBindingIdictionaryEnvironment) :: DictionaryEnvironment) -> + _functionBindingIdictionaryEnvironment + {-# INLINE rule2084 #-} + rule2084 = \ ((_functionBindingIelements) :: ([PatternElement], Bool) ) -> + _functionBindingIelements + {-# INLINE rule2085 #-} + rule2085 = \ ((_functionBindingIinfoTree) :: InfoTree) -> + _functionBindingIinfoTree + {-# INLINE rule2086 #-} + rule2086 = \ ((_functionBindingImatchIO) :: IO ()) -> + _functionBindingImatchIO + {-# INLINE rule2087 #-} + rule2087 = \ ((_functionBindingIname) :: Name) -> + _functionBindingIname + {-# INLINE rule2088 #-} + rule2088 = \ ((_functionBindingInumberOfPatterns) :: Int) -> + _functionBindingInumberOfPatterns + {-# INLINE rule2089 #-} + rule2089 = \ ((_functionBindingIpatternMatchWarnings) :: [Warning]) -> + _functionBindingIpatternMatchWarnings + {-# INLINE rule2090 #-} + rule2090 = \ ((_functionBindingIuniqueChunk) :: Int) -> + _functionBindingIuniqueChunk + {-# INLINE rule2091 #-} + rule2091 = \ ((_functionBindingIunrwar) :: Warning) -> + _functionBindingIunrwar + {-# INLINE rule2092 #-} + rule2092 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule2093 #-} + rule2093 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule2094 #-} + rule2094 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule2095 #-} + rule2095 = \ ((_lhsIbetaRight) :: Tp) -> + _lhsIbetaRight + {-# INLINE rule2096 #-} + rule2096 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2097 #-} + rule2097 = \ ((_lhsIbetasLeft) :: Tps) -> + _lhsIbetasLeft + {-# INLINE rule2098 #-} + rule2098 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2099 #-} + rule2099 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2100 #-} + rule2100 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2101 #-} + rule2101 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2102 #-} + rule2102 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule2103 #-} + rule2103 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2104 #-} + rule2104 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2105 #-} + rule2105 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2106 #-} + rule2106 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2107 #-} + rule2107 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2108 #-} + rule2108 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2109 #-} + rule2109 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2110 #-} + rule2110 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2111 #-} + rule2111 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule2112 #-} + rule2112 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule2113 #-} + rule2113 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_FunctionBinding_FunctionBinding #-} +sem_FunctionBinding_FunctionBinding :: T_Range -> T_LeftHandSide -> T_RightHandSide -> T_FunctionBinding +sem_FunctionBinding_FunctionBinding arg_range_ arg_lefthandside_ arg_righthandside_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIbetasLeft _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIargcount _lefthandsideIbetaUnique _lefthandsideIbetas _lefthandsideIconstraints _lefthandsideIcounter _lefthandsideIelements _lefthandsideIenvironment _lefthandsideIinfoTrees _lefthandsideIname _lefthandsideInumberOfPatterns _lefthandsideIpatVarNames _lefthandsideIpatternMatchWarnings _lefthandsideIself _lefthandsideIunboundNames) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 _lefthandsideObetaUnique _lefthandsideOcounter _lefthandsideOimportEnvironment _lefthandsideOmonos _lefthandsideOnamesInScope _lefthandsideOparentTree _lefthandsideOpatternMatchWarnings) + (T_RightHandSide_vOut148 _righthandsideIassumptions _righthandsideIbetaUnique _righthandsideIcollectErrors _righthandsideIcollectInstances _righthandsideIcollectWarnings _righthandsideIconstraints _righthandsideIcounter _righthandsideIdictionaryEnvironment _righthandsideIfallthrough _righthandsideIinfoTree _righthandsideImatchIO _righthandsideIpatternMatchWarnings _righthandsideIself _righthandsideIunboundNames _righthandsideIuniqueChunk) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOallPatterns _righthandsideOallTypeSchemes _righthandsideOavailablePredicates _righthandsideObetaRight _righthandsideObetaUnique _righthandsideOclassEnvironment _righthandsideOcollectErrors _righthandsideOcollectWarnings _righthandsideOcounter _righthandsideOcurrentChunk _righthandsideOdictionaryEnvironment _righthandsideOimportEnvironment _righthandsideOmatchIO _righthandsideOmonos _righthandsideOnamesInScope _righthandsideOorderedTypeSynonyms _righthandsideOparentTree _righthandsideOpatternMatchWarnings _righthandsideOsubstitution _righthandsideOtypeschemeMap _righthandsideOuniqueChunk) + _righthandsideOmonos = rule2114 _csetBinds _lefthandsideIenvironment _lhsImonos + _constraints = rule2115 _conLeft _csetBinds _lefthandsideIconstraints _righthandsideIconstraints + _conLeft = rule2116 _cinfoLeft _lefthandsideIbetas _lhsIbetasLeft + _lhsOassumptions :: Assumptions + (_csetBinds,_lhsOassumptions) = rule2117 _cinfoBind _lefthandsideIenvironment _righthandsideIassumptions + _cinfoLeft = rule2118 _lhsIbetasLeft _lhsIparentTree _parentTree + _cinfoBind = rule2119 _lefthandsideIenvironment _parentTree + _localInfo = rule2120 _lhsImonos _self + _parentTree = rule2121 _lefthandsideIinfoTrees _lhsIparentTree _localInfo _righthandsideIinfoTree + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2122 _parentTree + (_namesInScope,_unboundNames,_scopeInfo) = rule2123 _lefthandsideIpatVarNames _lhsInamesInScope _righthandsideIunboundNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2124 _unboundNames + _lhsOunrwar :: Warning + _lhsOunrwar = rule2125 _lefthandsideIself + _lhsOelements :: ([PatternElement], Bool) + _lhsOelements = rule2126 _lefthandsideIelements _righthandsideIfallthrough + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2127 _righthandsideIcollectInstances + _self = rule2128 _lefthandsideIself _rangeIself _righthandsideIself + _lhsOself :: FunctionBinding + _lhsOself = rule2129 _self + _lhsOargcount :: Int + _lhsOargcount = rule2130 _lefthandsideIargcount + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2131 _righthandsideIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2132 _righthandsideIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2133 _righthandsideIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2134 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2135 _righthandsideIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2136 _righthandsideIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2137 _righthandsideImatchIO + _lhsOname :: Name + _lhsOname = rule2138 _lefthandsideIname + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule2139 _lefthandsideInumberOfPatterns + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2140 _righthandsideIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2141 _righthandsideIuniqueChunk + _lefthandsideObetaUnique = rule2142 _lhsIbetaUnique + _lefthandsideOcounter = rule2143 _lhsIcounter + _lefthandsideOimportEnvironment = rule2144 _lhsIimportEnvironment + _lefthandsideOmonos = rule2145 _lhsImonos + _lefthandsideOnamesInScope = rule2146 _namesInScope + _lefthandsideOparentTree = rule2147 _parentTree + _lefthandsideOpatternMatchWarnings = rule2148 _lhsIpatternMatchWarnings + _righthandsideOallPatterns = rule2149 _lhsIallPatterns + _righthandsideOallTypeSchemes = rule2150 _lhsIallTypeSchemes + _righthandsideOavailablePredicates = rule2151 _lhsIavailablePredicates + _righthandsideObetaRight = rule2152 _lhsIbetaRight + _righthandsideObetaUnique = rule2153 _lefthandsideIbetaUnique + _righthandsideOclassEnvironment = rule2154 _lhsIclassEnvironment + _righthandsideOcollectErrors = rule2155 _lhsIcollectErrors + _righthandsideOcollectWarnings = rule2156 _lhsIcollectWarnings + _righthandsideOcounter = rule2157 _lefthandsideIcounter + _righthandsideOcurrentChunk = rule2158 _lhsIcurrentChunk + _righthandsideOdictionaryEnvironment = rule2159 _lhsIdictionaryEnvironment + _righthandsideOimportEnvironment = rule2160 _lhsIimportEnvironment + _righthandsideOmatchIO = rule2161 _lhsImatchIO + _righthandsideOnamesInScope = rule2162 _namesInScope + _righthandsideOorderedTypeSynonyms = rule2163 _lhsIorderedTypeSynonyms + _righthandsideOparentTree = rule2164 _parentTree + _righthandsideOpatternMatchWarnings = rule2165 _lefthandsideIpatternMatchWarnings + _righthandsideOsubstitution = rule2166 _lhsIsubstitution + _righthandsideOtypeschemeMap = rule2167 _lhsItypeschemeMap + _righthandsideOuniqueChunk = rule2168 _lhsIuniqueChunk + __result_ = T_FunctionBinding_vOut55 _lhsOargcount _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOelements _lhsOinfoTree _lhsOmatchIO _lhsOname _lhsOnumberOfPatterns _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwar + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule2114 #-} + rule2114 = \ _csetBinds ((_lefthandsideIenvironment) :: PatternAssumptions) ((_lhsImonos) :: Monos) -> + M.elems _lefthandsideIenvironment ++ getMonos _csetBinds ++ _lhsImonos + {-# INLINE rule2115 #-} + rule2115 = \ _conLeft _csetBinds ((_lefthandsideIconstraints) :: ConstraintSet) ((_righthandsideIconstraints) :: ConstraintSet) -> + _csetBinds .>>. + Node [ _conLeft .<. _lefthandsideIconstraints + , _righthandsideIconstraints + ] + {-# INLINE rule2116 #-} + rule2116 = \ _cinfoLeft ((_lefthandsideIbetas) :: Tps) ((_lhsIbetasLeft) :: Tps) -> + zipWith3 (\t1 t2 nr -> (t1 .==. t2) (_cinfoLeft nr)) _lefthandsideIbetas _lhsIbetasLeft [0..] + {-# INLINE rule2117 #-} + rule2117 = \ _cinfoBind ((_lefthandsideIenvironment) :: PatternAssumptions) ((_righthandsideIassumptions) :: Assumptions) -> + (_lefthandsideIenvironment .===. _righthandsideIassumptions) _cinfoBind + {-# INLINE rule2118 #-} + rule2118 = \ ((_lhsIbetasLeft) :: Tps) ((_lhsIparentTree) :: InfoTree) _parentTree -> + \num -> + orphanConstraint num "pattern of function binding" _parentTree + [ Unifier (head (ftv (_lhsIbetasLeft !! num))) (ordinal True (num+1)++" pattern of function bindings", attribute _lhsIparentTree, "pattern") ] + {-# INLINE rule2119 #-} + rule2119 = \ ((_lefthandsideIenvironment) :: PatternAssumptions) _parentTree -> + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint + , makeUnifier name "function binding" _lefthandsideIenvironment _parentTree + ] + {-# INLINE rule2120 #-} + rule2120 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_FB _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule2121 #-} + rule2121 = \ ((_lefthandsideIinfoTrees) :: InfoTrees) ((_lhsIparentTree) :: InfoTree) _localInfo ((_righthandsideIinfoTree) :: InfoTree) -> + node _lhsIparentTree _localInfo (_lefthandsideIinfoTrees ++ [_righthandsideIinfoTree]) + {-# INLINE rule2122 #-} + rule2122 = \ _parentTree -> + _parentTree + {-# INLINE rule2123 #-} + rule2123 = \ ((_lefthandsideIpatVarNames) :: Names) ((_lhsInamesInScope) :: Names) ((_righthandsideIunboundNames) :: Names) -> + changeOfScope _lefthandsideIpatVarNames _righthandsideIunboundNames _lhsInamesInScope + {-# INLINE rule2124 #-} + rule2124 = \ _unboundNames -> + _unboundNames + {-# INLINE rule2125 #-} + rule2125 = \ ((_lefthandsideIself) :: LeftHandSide) -> + UnreachablePatternLHS _lefthandsideIself + {-# INLINE rule2126 #-} + rule2126 = \ ((_lefthandsideIelements) :: [PatternElement] ) ((_righthandsideIfallthrough) :: Bool) -> + (_lefthandsideIelements, _righthandsideIfallthrough) + {-# INLINE rule2127 #-} + rule2127 = \ ((_righthandsideIcollectInstances) :: [(Name, Instance)]) -> + _righthandsideIcollectInstances + {-# INLINE rule2128 #-} + rule2128 = \ ((_lefthandsideIself) :: LeftHandSide) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + FunctionBinding_FunctionBinding _rangeIself _lefthandsideIself _righthandsideIself + {-# INLINE rule2129 #-} + rule2129 = \ _self -> + _self + {-# INLINE rule2130 #-} + rule2130 = \ ((_lefthandsideIargcount) :: Int) -> + _lefthandsideIargcount + {-# INLINE rule2131 #-} + rule2131 = \ ((_righthandsideIbetaUnique) :: Int) -> + _righthandsideIbetaUnique + {-# INLINE rule2132 #-} + rule2132 = \ ((_righthandsideIcollectErrors) :: TypeErrors) -> + _righthandsideIcollectErrors + {-# INLINE rule2133 #-} + rule2133 = \ ((_righthandsideIcollectWarnings) :: Warnings) -> + _righthandsideIcollectWarnings + {-# INLINE rule2134 #-} + rule2134 = \ _constraints -> + _constraints + {-# INLINE rule2135 #-} + rule2135 = \ ((_righthandsideIcounter) :: Int) -> + _righthandsideIcounter + {-# INLINE rule2136 #-} + rule2136 = \ ((_righthandsideIdictionaryEnvironment) :: DictionaryEnvironment) -> + _righthandsideIdictionaryEnvironment + {-# INLINE rule2137 #-} + rule2137 = \ ((_righthandsideImatchIO) :: IO ()) -> + _righthandsideImatchIO + {-# INLINE rule2138 #-} + rule2138 = \ ((_lefthandsideIname) :: Name) -> + _lefthandsideIname + {-# INLINE rule2139 #-} + rule2139 = \ ((_lefthandsideInumberOfPatterns) :: Int) -> + _lefthandsideInumberOfPatterns + {-# INLINE rule2140 #-} + rule2140 = \ ((_righthandsideIpatternMatchWarnings) :: [Warning]) -> + _righthandsideIpatternMatchWarnings + {-# INLINE rule2141 #-} + rule2141 = \ ((_righthandsideIuniqueChunk) :: Int) -> + _righthandsideIuniqueChunk + {-# INLINE rule2142 #-} + rule2142 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2143 #-} + rule2143 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2144 #-} + rule2144 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2145 #-} + rule2145 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2146 #-} + rule2146 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2147 #-} + rule2147 = \ _parentTree -> + _parentTree + {-# INLINE rule2148 #-} + rule2148 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2149 #-} + rule2149 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule2150 #-} + rule2150 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule2151 #-} + rule2151 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule2152 #-} + rule2152 = \ ((_lhsIbetaRight) :: Tp) -> + _lhsIbetaRight + {-# INLINE rule2153 #-} + rule2153 = \ ((_lefthandsideIbetaUnique) :: Int) -> + _lefthandsideIbetaUnique + {-# INLINE rule2154 #-} + rule2154 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2155 #-} + rule2155 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2156 #-} + rule2156 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2157 #-} + rule2157 = \ ((_lefthandsideIcounter) :: Int) -> + _lefthandsideIcounter + {-# INLINE rule2158 #-} + rule2158 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule2159 #-} + rule2159 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2160 #-} + rule2160 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2161 #-} + rule2161 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2162 #-} + rule2162 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2163 #-} + rule2163 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2164 #-} + rule2164 = \ _parentTree -> + _parentTree + {-# INLINE rule2165 #-} + rule2165 = \ ((_lefthandsideIpatternMatchWarnings) :: [Warning]) -> + _lefthandsideIpatternMatchWarnings + {-# INLINE rule2166 #-} + rule2166 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule2167 #-} + rule2167 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule2168 #-} + rule2168 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + +-- FunctionBindings -------------------------------------------- +-- wrapper +data Inh_FunctionBindings = Inh_FunctionBindings { allPatterns_Inh_FunctionBindings :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_FunctionBindings :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_FunctionBindings :: (Predicates), betaRight_Inh_FunctionBindings :: (Tp), betaUnique_Inh_FunctionBindings :: (Int), betasLeft_Inh_FunctionBindings :: (Tps), classEnvironment_Inh_FunctionBindings :: (ClassEnvironment), collectErrors_Inh_FunctionBindings :: (TypeErrors), collectWarnings_Inh_FunctionBindings :: (Warnings), counter_Inh_FunctionBindings :: (Int), currentChunk_Inh_FunctionBindings :: (Int), dictionaryEnvironment_Inh_FunctionBindings :: (DictionaryEnvironment), importEnvironment_Inh_FunctionBindings :: (ImportEnvironment), matchIO_Inh_FunctionBindings :: (IO ()), monos_Inh_FunctionBindings :: (Monos), namesInScope_Inh_FunctionBindings :: (Names), orderedTypeSynonyms_Inh_FunctionBindings :: (OrderedTypeSynonyms), parentTree_Inh_FunctionBindings :: (InfoTree), patternMatchWarnings_Inh_FunctionBindings :: ([Warning]), substitution_Inh_FunctionBindings :: (FixpointSubstitution), typeschemeMap_Inh_FunctionBindings :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_FunctionBindings :: (Int) } +data Syn_FunctionBindings = Syn_FunctionBindings { argcount_Syn_FunctionBindings :: (Int), assumptions_Syn_FunctionBindings :: (Assumptions), betaUnique_Syn_FunctionBindings :: (Int), collectErrors_Syn_FunctionBindings :: (TypeErrors), collectInstances_Syn_FunctionBindings :: ([(Name, Instance)]), collectWarnings_Syn_FunctionBindings :: (Warnings), constraintslist_Syn_FunctionBindings :: (ConstraintSets), counter_Syn_FunctionBindings :: (Int), dictionaryEnvironment_Syn_FunctionBindings :: (DictionaryEnvironment), elementss_Syn_FunctionBindings :: ([([PatternElement], Bool)]), infoTrees_Syn_FunctionBindings :: (InfoTrees), matchIO_Syn_FunctionBindings :: (IO ()), name_Syn_FunctionBindings :: (Name), numberOfPatterns_Syn_FunctionBindings :: (Int), patternMatchWarnings_Syn_FunctionBindings :: ([Warning]), self_Syn_FunctionBindings :: (FunctionBindings), unboundNames_Syn_FunctionBindings :: (Names), uniqueChunk_Syn_FunctionBindings :: (Int), unrwars_Syn_FunctionBindings :: ([Warning]) } +{-# INLINABLE wrap_FunctionBindings #-} +wrap_FunctionBindings :: T_FunctionBindings -> Inh_FunctionBindings -> (Syn_FunctionBindings ) +wrap_FunctionBindings (T_FunctionBindings act) (Inh_FunctionBindings _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIbetasLeft _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBindings_vIn58 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIbetasLeft _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk + (T_FunctionBindings_vOut58 _lhsOargcount _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOelementss _lhsOinfoTrees _lhsOmatchIO _lhsOname _lhsOnumberOfPatterns _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwars) <- return (inv_FunctionBindings_s59 sem arg) + return (Syn_FunctionBindings _lhsOargcount _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOelementss _lhsOinfoTrees _lhsOmatchIO _lhsOname _lhsOnumberOfPatterns _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwars) + ) + +-- cata +{-# NOINLINE sem_FunctionBindings #-} +sem_FunctionBindings :: FunctionBindings -> T_FunctionBindings +sem_FunctionBindings list = Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list) + +-- semantic domain +newtype T_FunctionBindings = T_FunctionBindings { + attach_T_FunctionBindings :: Identity (T_FunctionBindings_s59 ) + } +newtype T_FunctionBindings_s59 = C_FunctionBindings_s59 { + inv_FunctionBindings_s59 :: (T_FunctionBindings_v58 ) + } +data T_FunctionBindings_s60 = C_FunctionBindings_s60 +type T_FunctionBindings_v58 = (T_FunctionBindings_vIn58 ) -> (T_FunctionBindings_vOut58 ) +data T_FunctionBindings_vIn58 = T_FunctionBindings_vIn58 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Tp) (Int) (Tps) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Int) +data T_FunctionBindings_vOut58 = T_FunctionBindings_vOut58 (Int) (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSets) (Int) (DictionaryEnvironment) ([([PatternElement], Bool)]) (InfoTrees) (IO ()) (Name) (Int) ([Warning]) (FunctionBindings) (Names) (Int) ([Warning]) +{-# NOINLINE sem_FunctionBindings_Cons #-} +sem_FunctionBindings_Cons :: T_FunctionBinding -> T_FunctionBindings -> T_FunctionBindings +sem_FunctionBindings_Cons arg_hd_ arg_tl_ = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIbetasLeft _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _hdX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_hd_)) + _tlX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_tl_)) + (T_FunctionBinding_vOut55 _hdIargcount _hdIassumptions _hdIbetaUnique _hdIcollectErrors _hdIcollectInstances _hdIcollectWarnings _hdIconstraints _hdIcounter _hdIdictionaryEnvironment _hdIelements _hdIinfoTree _hdImatchIO _hdIname _hdInumberOfPatterns _hdIpatternMatchWarnings _hdIself _hdIunboundNames _hdIuniqueChunk _hdIunrwar) = inv_FunctionBinding_s56 _hdX56 (T_FunctionBinding_vIn55 _hdOallPatterns _hdOallTypeSchemes _hdOavailablePredicates _hdObetaRight _hdObetaUnique _hdObetasLeft _hdOclassEnvironment _hdOcollectErrors _hdOcollectWarnings _hdOcounter _hdOcurrentChunk _hdOdictionaryEnvironment _hdOimportEnvironment _hdOmatchIO _hdOmonos _hdOnamesInScope _hdOorderedTypeSynonyms _hdOparentTree _hdOpatternMatchWarnings _hdOsubstitution _hdOtypeschemeMap _hdOuniqueChunk) + (T_FunctionBindings_vOut58 _tlIargcount _tlIassumptions _tlIbetaUnique _tlIcollectErrors _tlIcollectInstances _tlIcollectWarnings _tlIconstraintslist _tlIcounter _tlIdictionaryEnvironment _tlIelementss _tlIinfoTrees _tlImatchIO _tlIname _tlInumberOfPatterns _tlIpatternMatchWarnings _tlIself _tlIunboundNames _tlIuniqueChunk _tlIunrwars) = inv_FunctionBindings_s59 _tlX59 (T_FunctionBindings_vIn58 _tlOallPatterns _tlOallTypeSchemes _tlOavailablePredicates _tlObetaRight _tlObetaUnique _tlObetasLeft _tlOclassEnvironment _tlOcollectErrors _tlOcollectWarnings _tlOcounter _tlOcurrentChunk _tlOdictionaryEnvironment _tlOimportEnvironment _tlOmatchIO _tlOmonos _tlOnamesInScope _tlOorderedTypeSynonyms _tlOparentTree _tlOpatternMatchWarnings _tlOsubstitution _tlOtypeschemeMap _tlOuniqueChunk) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2169 _hdIassumptions _tlIassumptions + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule2170 _hdInumberOfPatterns + _lhsOname :: Name + _lhsOname = rule2171 _hdIname + _lhsOconstraintslist :: ConstraintSets + _lhsOconstraintslist = rule2172 _hdIconstraints _tlIconstraintslist + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2173 _hdIinfoTree _tlIinfoTrees + _lhsOelementss :: [([PatternElement], Bool)] + _lhsOelementss = rule2174 _hdIelements _tlIelementss + _lhsOunrwars :: [Warning] + _lhsOunrwars = rule2175 _hdIunrwar _tlIunrwars + _lhsOargcount :: Int + _lhsOargcount = rule2176 _hdIargcount + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2177 _hdIcollectInstances _tlIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2178 _hdIunboundNames _tlIunboundNames + _self = rule2179 _hdIself _tlIself + _lhsOself :: FunctionBindings + _lhsOself = rule2180 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2181 _tlIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2182 _tlIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2183 _tlIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule2184 _tlIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2185 _tlIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2186 _tlImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2187 _tlIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2188 _tlIuniqueChunk + _hdOallPatterns = rule2189 _lhsIallPatterns + _hdOallTypeSchemes = rule2190 _lhsIallTypeSchemes + _hdOavailablePredicates = rule2191 _lhsIavailablePredicates + _hdObetaRight = rule2192 _lhsIbetaRight + _hdObetaUnique = rule2193 _lhsIbetaUnique + _hdObetasLeft = rule2194 _lhsIbetasLeft + _hdOclassEnvironment = rule2195 _lhsIclassEnvironment + _hdOcollectErrors = rule2196 _lhsIcollectErrors + _hdOcollectWarnings = rule2197 _lhsIcollectWarnings + _hdOcounter = rule2198 _lhsIcounter + _hdOcurrentChunk = rule2199 _lhsIcurrentChunk + _hdOdictionaryEnvironment = rule2200 _lhsIdictionaryEnvironment + _hdOimportEnvironment = rule2201 _lhsIimportEnvironment + _hdOmatchIO = rule2202 _lhsImatchIO + _hdOmonos = rule2203 _lhsImonos + _hdOnamesInScope = rule2204 _lhsInamesInScope + _hdOorderedTypeSynonyms = rule2205 _lhsIorderedTypeSynonyms + _hdOparentTree = rule2206 _lhsIparentTree + _hdOpatternMatchWarnings = rule2207 _lhsIpatternMatchWarnings + _hdOsubstitution = rule2208 _lhsIsubstitution + _hdOtypeschemeMap = rule2209 _lhsItypeschemeMap + _hdOuniqueChunk = rule2210 _lhsIuniqueChunk + _tlOallPatterns = rule2211 _lhsIallPatterns + _tlOallTypeSchemes = rule2212 _lhsIallTypeSchemes + _tlOavailablePredicates = rule2213 _lhsIavailablePredicates + _tlObetaRight = rule2214 _lhsIbetaRight + _tlObetaUnique = rule2215 _hdIbetaUnique + _tlObetasLeft = rule2216 _lhsIbetasLeft + _tlOclassEnvironment = rule2217 _lhsIclassEnvironment + _tlOcollectErrors = rule2218 _hdIcollectErrors + _tlOcollectWarnings = rule2219 _hdIcollectWarnings + _tlOcounter = rule2220 _hdIcounter + _tlOcurrentChunk = rule2221 _lhsIcurrentChunk + _tlOdictionaryEnvironment = rule2222 _hdIdictionaryEnvironment + _tlOimportEnvironment = rule2223 _lhsIimportEnvironment + _tlOmatchIO = rule2224 _hdImatchIO + _tlOmonos = rule2225 _lhsImonos + _tlOnamesInScope = rule2226 _lhsInamesInScope + _tlOorderedTypeSynonyms = rule2227 _lhsIorderedTypeSynonyms + _tlOparentTree = rule2228 _lhsIparentTree + _tlOpatternMatchWarnings = rule2229 _hdIpatternMatchWarnings + _tlOsubstitution = rule2230 _lhsIsubstitution + _tlOtypeschemeMap = rule2231 _lhsItypeschemeMap + _tlOuniqueChunk = rule2232 _hdIuniqueChunk + __result_ = T_FunctionBindings_vOut58 _lhsOargcount _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOelementss _lhsOinfoTrees _lhsOmatchIO _lhsOname _lhsOnumberOfPatterns _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwars + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule2169 #-} + rule2169 = \ ((_hdIassumptions) :: Assumptions) ((_tlIassumptions) :: Assumptions) -> + _hdIassumptions `combine` _tlIassumptions + {-# INLINE rule2170 #-} + rule2170 = \ ((_hdInumberOfPatterns) :: Int) -> + _hdInumberOfPatterns + {-# INLINE rule2171 #-} + rule2171 = \ ((_hdIname) :: Name) -> + _hdIname + {-# INLINE rule2172 #-} + rule2172 = \ ((_hdIconstraints) :: ConstraintSet) ((_tlIconstraintslist) :: ConstraintSets) -> + _hdIconstraints : _tlIconstraintslist + {-# INLINE rule2173 #-} + rule2173 = \ ((_hdIinfoTree) :: InfoTree) ((_tlIinfoTrees) :: InfoTrees) -> + _hdIinfoTree : _tlIinfoTrees + {-# INLINE rule2174 #-} + rule2174 = \ ((_hdIelements) :: ([PatternElement], Bool) ) ((_tlIelementss) :: [([PatternElement], Bool)]) -> + _hdIelements : _tlIelementss + {-# INLINE rule2175 #-} + rule2175 = \ ((_hdIunrwar) :: Warning) ((_tlIunrwars) :: [Warning]) -> + _hdIunrwar : _tlIunrwars + {-# INLINE rule2176 #-} + rule2176 = \ ((_hdIargcount) :: Int) -> + _hdIargcount + {-# INLINE rule2177 #-} + rule2177 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule2178 #-} + rule2178 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule2179 #-} + rule2179 = \ ((_hdIself) :: FunctionBinding) ((_tlIself) :: FunctionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule2180 #-} + rule2180 = \ _self -> + _self + {-# INLINE rule2181 #-} + rule2181 = \ ((_tlIbetaUnique) :: Int) -> + _tlIbetaUnique + {-# INLINE rule2182 #-} + rule2182 = \ ((_tlIcollectErrors) :: TypeErrors) -> + _tlIcollectErrors + {-# INLINE rule2183 #-} + rule2183 = \ ((_tlIcollectWarnings) :: Warnings) -> + _tlIcollectWarnings + {-# INLINE rule2184 #-} + rule2184 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule2185 #-} + rule2185 = \ ((_tlIdictionaryEnvironment) :: DictionaryEnvironment) -> + _tlIdictionaryEnvironment + {-# INLINE rule2186 #-} + rule2186 = \ ((_tlImatchIO) :: IO ()) -> + _tlImatchIO + {-# INLINE rule2187 #-} + rule2187 = \ ((_tlIpatternMatchWarnings) :: [Warning]) -> + _tlIpatternMatchWarnings + {-# INLINE rule2188 #-} + rule2188 = \ ((_tlIuniqueChunk) :: Int) -> + _tlIuniqueChunk + {-# INLINE rule2189 #-} + rule2189 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule2190 #-} + rule2190 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule2191 #-} + rule2191 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule2192 #-} + rule2192 = \ ((_lhsIbetaRight) :: Tp) -> + _lhsIbetaRight + {-# INLINE rule2193 #-} + rule2193 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2194 #-} + rule2194 = \ ((_lhsIbetasLeft) :: Tps) -> + _lhsIbetasLeft + {-# INLINE rule2195 #-} + rule2195 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2196 #-} + rule2196 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2197 #-} + rule2197 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2198 #-} + rule2198 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2199 #-} + rule2199 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule2200 #-} + rule2200 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2201 #-} + rule2201 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2202 #-} + rule2202 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2203 #-} + rule2203 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2204 #-} + rule2204 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2205 #-} + rule2205 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2206 #-} + rule2206 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2207 #-} + rule2207 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2208 #-} + rule2208 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule2209 #-} + rule2209 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule2210 #-} + rule2210 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule2211 #-} + rule2211 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule2212 #-} + rule2212 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule2213 #-} + rule2213 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule2214 #-} + rule2214 = \ ((_lhsIbetaRight) :: Tp) -> + _lhsIbetaRight + {-# INLINE rule2215 #-} + rule2215 = \ ((_hdIbetaUnique) :: Int) -> + _hdIbetaUnique + {-# INLINE rule2216 #-} + rule2216 = \ ((_lhsIbetasLeft) :: Tps) -> + _lhsIbetasLeft + {-# INLINE rule2217 #-} + rule2217 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2218 #-} + rule2218 = \ ((_hdIcollectErrors) :: TypeErrors) -> + _hdIcollectErrors + {-# INLINE rule2219 #-} + rule2219 = \ ((_hdIcollectWarnings) :: Warnings) -> + _hdIcollectWarnings + {-# INLINE rule2220 #-} + rule2220 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule2221 #-} + rule2221 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule2222 #-} + rule2222 = \ ((_hdIdictionaryEnvironment) :: DictionaryEnvironment) -> + _hdIdictionaryEnvironment + {-# INLINE rule2223 #-} + rule2223 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2224 #-} + rule2224 = \ ((_hdImatchIO) :: IO ()) -> + _hdImatchIO + {-# INLINE rule2225 #-} + rule2225 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2226 #-} + rule2226 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2227 #-} + rule2227 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2228 #-} + rule2228 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2229 #-} + rule2229 = \ ((_hdIpatternMatchWarnings) :: [Warning]) -> + _hdIpatternMatchWarnings + {-# INLINE rule2230 #-} + rule2230 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule2231 #-} + rule2231 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule2232 #-} + rule2232 = \ ((_hdIuniqueChunk) :: Int) -> + _hdIuniqueChunk +{-# NOINLINE sem_FunctionBindings_Nil #-} +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIbetasLeft _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2233 () + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule2234 () + _lhsOname :: Name + _lhsOname = rule2235 () + _lhsOconstraintslist :: ConstraintSets + _lhsOconstraintslist = rule2236 () + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2237 () + _lhsOelementss :: [([PatternElement], Bool)] + _lhsOelementss = rule2238 () + _lhsOunrwars :: [Warning] + _lhsOunrwars = rule2239 () + _lhsOargcount :: Int + _lhsOargcount = rule2240 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2241 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2242 () + _self = rule2243 () + _lhsOself :: FunctionBindings + _lhsOself = rule2244 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2245 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2246 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2247 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule2248 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2249 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2250 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2251 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2252 _lhsIuniqueChunk + __result_ = T_FunctionBindings_vOut58 _lhsOargcount _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOelementss _lhsOinfoTrees _lhsOmatchIO _lhsOname _lhsOnumberOfPatterns _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOunrwars + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule2233 #-} + rule2233 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule2234 #-} + rule2234 = \ (_ :: ()) -> + internalError "TypeInferencing.ag" "n/a" "FunctionBindings(1)" + {-# INLINE rule2235 #-} + rule2235 = \ (_ :: ()) -> + internalError "TypeInferencing.ag" "n/a" "FunctionBindings(2)" + {-# INLINE rule2236 #-} + rule2236 = \ (_ :: ()) -> + [] + {-# INLINE rule2237 #-} + rule2237 = \ (_ :: ()) -> + [] + {-# INLINE rule2238 #-} + rule2238 = \ (_ :: ()) -> + [] + {-# INLINE rule2239 #-} + rule2239 = \ (_ :: ()) -> + [] + {-# INLINE rule2240 #-} + rule2240 = \ (_ :: ()) -> + pmError "FunctionBindings_Nil.argcount" "?empty list of function bindings?" + {-# INLINE rule2241 #-} + rule2241 = \ (_ :: ()) -> + [] + {-# INLINE rule2242 #-} + rule2242 = \ (_ :: ()) -> + [] + {-# INLINE rule2243 #-} + rule2243 = \ (_ :: ()) -> + [] + {-# INLINE rule2244 #-} + rule2244 = \ _self -> + _self + {-# INLINE rule2245 #-} + rule2245 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2246 #-} + rule2246 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2247 #-} + rule2247 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2248 #-} + rule2248 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2249 #-} + rule2249 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2250 #-} + rule2250 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2251 #-} + rule2251 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2252 #-} + rule2252 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + +-- GuardedExpression ------------------------------------------- +-- wrapper +data Inh_GuardedExpression = Inh_GuardedExpression { allPatterns_Inh_GuardedExpression :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_GuardedExpression :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_GuardedExpression :: (Predicates), betaRight_Inh_GuardedExpression :: (Tp), betaUnique_Inh_GuardedExpression :: (Int), classEnvironment_Inh_GuardedExpression :: (ClassEnvironment), collectErrors_Inh_GuardedExpression :: (TypeErrors), collectWarnings_Inh_GuardedExpression :: (Warnings), counter_Inh_GuardedExpression :: (Int), currentChunk_Inh_GuardedExpression :: (Int), dictionaryEnvironment_Inh_GuardedExpression :: (DictionaryEnvironment), importEnvironment_Inh_GuardedExpression :: (ImportEnvironment), matchIO_Inh_GuardedExpression :: (IO ()), monos_Inh_GuardedExpression :: (Monos), namesInScope_Inh_GuardedExpression :: (Names), numberOfGuards_Inh_GuardedExpression :: (Int), orderedTypeSynonyms_Inh_GuardedExpression :: (OrderedTypeSynonyms), parentTree_Inh_GuardedExpression :: (InfoTree), patternMatchWarnings_Inh_GuardedExpression :: ([Warning]), substitution_Inh_GuardedExpression :: (FixpointSubstitution), typeschemeMap_Inh_GuardedExpression :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_GuardedExpression :: (Int), uniqueSecondRound_Inh_GuardedExpression :: (Int) } +data Syn_GuardedExpression = Syn_GuardedExpression { assumptions_Syn_GuardedExpression :: (Assumptions), betaUnique_Syn_GuardedExpression :: (Int), collectErrors_Syn_GuardedExpression :: (TypeErrors), collectInstances_Syn_GuardedExpression :: ([(Name, Instance)]), collectWarnings_Syn_GuardedExpression :: (Warnings), constraints_Syn_GuardedExpression :: (ConstraintSet), counter_Syn_GuardedExpression :: (Int), dictionaryEnvironment_Syn_GuardedExpression :: (DictionaryEnvironment), fallthrough_Syn_GuardedExpression :: (Bool), infoTrees_Syn_GuardedExpression :: (InfoTrees), matchIO_Syn_GuardedExpression :: (IO ()), patternMatchWarnings_Syn_GuardedExpression :: ([Warning]), range_Syn_GuardedExpression :: (Range), self_Syn_GuardedExpression :: (GuardedExpression), unboundNames_Syn_GuardedExpression :: (Names), uniqueChunk_Syn_GuardedExpression :: (Int), uniqueSecondRound_Syn_GuardedExpression :: (Int), unrwar_Syn_GuardedExpression :: (Warning) } +{-# INLINABLE wrap_GuardedExpression #-} +wrap_GuardedExpression :: T_GuardedExpression -> Inh_GuardedExpression -> (Syn_GuardedExpression ) +wrap_GuardedExpression (T_GuardedExpression act) (Inh_GuardedExpression _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsInumberOfGuards _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpression_vIn61 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsInumberOfGuards _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound + (T_GuardedExpression_vOut61 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOfallthrough _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrange _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound _lhsOunrwar) <- return (inv_GuardedExpression_s62 sem arg) + return (Syn_GuardedExpression _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOfallthrough _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrange _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound _lhsOunrwar) + ) + +-- cata +{-# NOINLINE sem_GuardedExpression #-} +sem_GuardedExpression :: GuardedExpression -> T_GuardedExpression +sem_GuardedExpression ( GuardedExpression_GuardedExpression range_ guard_ expression_ ) = sem_GuardedExpression_GuardedExpression ( sem_Range range_ ) ( sem_Expression guard_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_GuardedExpression = T_GuardedExpression { + attach_T_GuardedExpression :: Identity (T_GuardedExpression_s62 ) + } +newtype T_GuardedExpression_s62 = C_GuardedExpression_s62 { + inv_GuardedExpression_s62 :: (T_GuardedExpression_v61 ) + } +data T_GuardedExpression_s63 = C_GuardedExpression_s63 +type T_GuardedExpression_v61 = (T_GuardedExpression_vIn61 ) -> (T_GuardedExpression_vOut61 ) +data T_GuardedExpression_vIn61 = T_GuardedExpression_vIn61 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Tp) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (Int) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Int) (Int) +data T_GuardedExpression_vOut61 = T_GuardedExpression_vOut61 (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (DictionaryEnvironment) (Bool) (InfoTrees) (IO ()) ([Warning]) (Range) (GuardedExpression) (Names) (Int) (Int) (Warning) +{-# NOINLINE sem_GuardedExpression_GuardedExpression #-} +sem_GuardedExpression_GuardedExpression :: T_Range -> T_Expression -> T_Expression -> T_GuardedExpression +sem_GuardedExpression_GuardedExpression arg_range_ arg_guard_ arg_expression_ = T_GuardedExpression (return st62) where + {-# NOINLINE st62 #-} + st62 = let + v61 :: T_GuardedExpression_v61 + v61 = \ (T_GuardedExpression_vIn61 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsInumberOfGuards _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIassumptions _guardIbeta _guardIbetaUnique _guardIcollectErrors _guardIcollectInstances _guardIcollectWarnings _guardIconstraints _guardIcounter _guardIdictionaryEnvironment _guardIinfoTree _guardImatchIO _guardImatches _guardIpatternMatchWarnings _guardIself _guardIunboundNames _guardIuniqueChunk _guardIuniqueSecondRound) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 _guardOallPatterns _guardOallTypeSchemes _guardOavailablePredicates _guardObetaUnique _guardOclassEnvironment _guardOcollectErrors _guardOcollectWarnings _guardOcounter _guardOcurrentChunk _guardOdictionaryEnvironment _guardOimportEnvironment _guardOmatchIO _guardOmonos _guardOnamesInScope _guardOorderedTypeSynonyms _guardOparentTree _guardOpatternMatchWarnings _guardOsubstitution _guardOtryPatterns _guardOtypeschemeMap _guardOuniqueChunk _guardOuniqueSecondRound) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2253 _expressionIconstraints _guardIconstraints _newconExpr _newconGuard + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2254 _expressionIassumptions _guardIassumptions + _newconGuard = rule2255 _cinfoGuard _guardIbeta + _newconExpr = rule2256 _cinfoExpr _expressionIbeta _lhsIbetaRight + _cinfoGuard = rule2257 _guardIinfoTree + _cinfoExpr = rule2258 _expressionIinfoTree _lhsIbetaRight _lhsInumberOfGuards _lhsIparentTree + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2259 _expressionIinfoTree _guardIinfoTree + _guardOtryPatterns = rule2260 () + _expressionOtryPatterns = rule2261 () + _lhsOfallthrough :: Bool + _lhsOfallthrough = rule2262 _guardIself + _lhsOunrwar :: Warning + _lhsOunrwar = rule2263 _guardIself _rangeIself + _lhsOrange :: Range + _lhsOrange = rule2264 _rangeIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2265 _expressionIcollectInstances _guardIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2266 _expressionIunboundNames _guardIunboundNames + _self = rule2267 _expressionIself _guardIself _rangeIself + _lhsOself :: GuardedExpression + _lhsOself = rule2268 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2269 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2270 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2271 _expressionIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule2272 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2273 _expressionIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2274 _expressionImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2275 _expressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2276 _expressionIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule2277 _expressionIuniqueSecondRound + _guardOallPatterns = rule2278 _lhsIallPatterns + _guardOallTypeSchemes = rule2279 _lhsIallTypeSchemes + _guardOavailablePredicates = rule2280 _lhsIavailablePredicates + _guardObetaUnique = rule2281 _lhsIbetaUnique + _guardOclassEnvironment = rule2282 _lhsIclassEnvironment + _guardOcollectErrors = rule2283 _lhsIcollectErrors + _guardOcollectWarnings = rule2284 _lhsIcollectWarnings + _guardOcounter = rule2285 _lhsIcounter + _guardOcurrentChunk = rule2286 _lhsIcurrentChunk + _guardOdictionaryEnvironment = rule2287 _lhsIdictionaryEnvironment + _guardOimportEnvironment = rule2288 _lhsIimportEnvironment + _guardOmatchIO = rule2289 _lhsImatchIO + _guardOmonos = rule2290 _lhsImonos + _guardOnamesInScope = rule2291 _lhsInamesInScope + _guardOorderedTypeSynonyms = rule2292 _lhsIorderedTypeSynonyms + _guardOparentTree = rule2293 _lhsIparentTree + _guardOpatternMatchWarnings = rule2294 _lhsIpatternMatchWarnings + _guardOsubstitution = rule2295 _lhsIsubstitution + _guardOtypeschemeMap = rule2296 _lhsItypeschemeMap + _guardOuniqueChunk = rule2297 _lhsIuniqueChunk + _guardOuniqueSecondRound = rule2298 _lhsIuniqueSecondRound + _expressionOallPatterns = rule2299 _lhsIallPatterns + _expressionOallTypeSchemes = rule2300 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule2301 _lhsIavailablePredicates + _expressionObetaUnique = rule2302 _guardIbetaUnique + _expressionOclassEnvironment = rule2303 _lhsIclassEnvironment + _expressionOcollectErrors = rule2304 _guardIcollectErrors + _expressionOcollectWarnings = rule2305 _guardIcollectWarnings + _expressionOcounter = rule2306 _guardIcounter + _expressionOcurrentChunk = rule2307 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule2308 _guardIdictionaryEnvironment + _expressionOimportEnvironment = rule2309 _lhsIimportEnvironment + _expressionOmatchIO = rule2310 _guardImatchIO + _expressionOmonos = rule2311 _lhsImonos + _expressionOnamesInScope = rule2312 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule2313 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule2314 _lhsIparentTree + _expressionOpatternMatchWarnings = rule2315 _guardIpatternMatchWarnings + _expressionOsubstitution = rule2316 _lhsIsubstitution + _expressionOtypeschemeMap = rule2317 _lhsItypeschemeMap + _expressionOuniqueChunk = rule2318 _guardIuniqueChunk + _expressionOuniqueSecondRound = rule2319 _guardIuniqueSecondRound + __result_ = T_GuardedExpression_vOut61 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOfallthrough _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOrange _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound _lhsOunrwar + in __result_ ) + in C_GuardedExpression_s62 v61 + {-# INLINE rule2253 #-} + rule2253 = \ ((_expressionIconstraints) :: ConstraintSet) ((_guardIconstraints) :: ConstraintSet) _newconExpr _newconGuard -> + Node [ _newconGuard .<. _guardIconstraints + , _newconExpr .<. _expressionIconstraints + ] + {-# INLINE rule2254 #-} + rule2254 = \ ((_expressionIassumptions) :: Assumptions) ((_guardIassumptions) :: Assumptions) -> + _guardIassumptions `combine` _expressionIassumptions + {-# INLINE rule2255 #-} + rule2255 = \ _cinfoGuard ((_guardIbeta) :: Tp) -> + [ (_guardIbeta .==. boolType) _cinfoGuard ] + {-# INLINE rule2256 #-} + rule2256 = \ _cinfoExpr ((_expressionIbeta) :: Tp) ((_lhsIbetaRight) :: Tp) -> + [ (_expressionIbeta .==. _lhsIbetaRight) _cinfoExpr ] + {-# INLINE rule2257 #-} + rule2257 = \ ((_guardIinfoTree) :: InfoTree) -> + resultConstraint "guard" _guardIinfoTree + [] + {-# INLINE rule2258 #-} + rule2258 = \ ((_expressionIinfoTree) :: InfoTree) ((_lhsIbetaRight) :: Tp) ((_lhsInumberOfGuards) :: Int) ((_lhsIparentTree) :: InfoTree) -> + resultConstraint "guarded expression" _expressionIinfoTree $ + [ HasTrustFactor 10.0 | _lhsInumberOfGuards < 2 ] ++ + [ Unifier (head (ftv _lhsIbetaRight)) ("right-hand sides", attribute (skip_UHA_FB_RHS _lhsIparentTree), "right-hand side") ] + {-# INLINE rule2259 #-} + rule2259 = \ ((_expressionIinfoTree) :: InfoTree) ((_guardIinfoTree) :: InfoTree) -> + [_guardIinfoTree, _expressionIinfoTree] + {-# INLINE rule2260 #-} + rule2260 = \ (_ :: ()) -> + [] + {-# INLINE rule2261 #-} + rule2261 = \ (_ :: ()) -> + [] + {-# INLINE rule2262 #-} + rule2262 = \ ((_guardIself) :: Expression) -> + case _guardIself + of Expression_Variable _ (Name_Identifier _ _ "otherwise") -> False + Expression_Constructor _ (Name_Identifier _ _ "True" ) -> False + _ -> True + {-# INLINE rule2263 #-} + rule2263 = \ ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + UnreachableGuard _rangeIself _guardIself + {-# INLINE rule2264 #-} + rule2264 = \ ((_rangeIself) :: Range) -> + _rangeIself + {-# INLINE rule2265 #-} + rule2265 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) ((_guardIcollectInstances) :: [(Name, Instance)]) -> + _guardIcollectInstances ++ _expressionIcollectInstances + {-# INLINE rule2266 #-} + rule2266 = \ ((_expressionIunboundNames) :: Names) ((_guardIunboundNames) :: Names) -> + _guardIunboundNames ++ _expressionIunboundNames + {-# INLINE rule2267 #-} + rule2267 = \ ((_expressionIself) :: Expression) ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + GuardedExpression_GuardedExpression _rangeIself _guardIself _expressionIself + {-# INLINE rule2268 #-} + rule2268 = \ _self -> + _self + {-# INLINE rule2269 #-} + rule2269 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule2270 #-} + rule2270 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule2271 #-} + rule2271 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule2272 #-} + rule2272 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule2273 #-} + rule2273 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule2274 #-} + rule2274 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule2275 #-} + rule2275 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule2276 #-} + rule2276 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule2277 #-} + rule2277 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule2278 #-} + rule2278 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule2279 #-} + rule2279 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule2280 #-} + rule2280 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule2281 #-} + rule2281 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2282 #-} + rule2282 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2283 #-} + rule2283 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2284 #-} + rule2284 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2285 #-} + rule2285 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2286 #-} + rule2286 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule2287 #-} + rule2287 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2288 #-} + rule2288 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2289 #-} + rule2289 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2290 #-} + rule2290 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2291 #-} + rule2291 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2292 #-} + rule2292 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2293 #-} + rule2293 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2294 #-} + rule2294 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2295 #-} + rule2295 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule2296 #-} + rule2296 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule2297 #-} + rule2297 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule2298 #-} + rule2298 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule2299 #-} + rule2299 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule2300 #-} + rule2300 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule2301 #-} + rule2301 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule2302 #-} + rule2302 = \ ((_guardIbetaUnique) :: Int) -> + _guardIbetaUnique + {-# INLINE rule2303 #-} + rule2303 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2304 #-} + rule2304 = \ ((_guardIcollectErrors) :: TypeErrors) -> + _guardIcollectErrors + {-# INLINE rule2305 #-} + rule2305 = \ ((_guardIcollectWarnings) :: Warnings) -> + _guardIcollectWarnings + {-# INLINE rule2306 #-} + rule2306 = \ ((_guardIcounter) :: Int) -> + _guardIcounter + {-# INLINE rule2307 #-} + rule2307 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule2308 #-} + rule2308 = \ ((_guardIdictionaryEnvironment) :: DictionaryEnvironment) -> + _guardIdictionaryEnvironment + {-# INLINE rule2309 #-} + rule2309 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2310 #-} + rule2310 = \ ((_guardImatchIO) :: IO ()) -> + _guardImatchIO + {-# INLINE rule2311 #-} + rule2311 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2312 #-} + rule2312 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2313 #-} + rule2313 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2314 #-} + rule2314 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2315 #-} + rule2315 = \ ((_guardIpatternMatchWarnings) :: [Warning]) -> + _guardIpatternMatchWarnings + {-# INLINE rule2316 #-} + rule2316 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule2317 #-} + rule2317 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule2318 #-} + rule2318 = \ ((_guardIuniqueChunk) :: Int) -> + _guardIuniqueChunk + {-# INLINE rule2319 #-} + rule2319 = \ ((_guardIuniqueSecondRound) :: Int) -> + _guardIuniqueSecondRound + +-- GuardedExpressions ------------------------------------------ +-- wrapper +data Inh_GuardedExpressions = Inh_GuardedExpressions { allPatterns_Inh_GuardedExpressions :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_GuardedExpressions :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_GuardedExpressions :: (Predicates), betaRight_Inh_GuardedExpressions :: (Tp), betaUnique_Inh_GuardedExpressions :: (Int), classEnvironment_Inh_GuardedExpressions :: (ClassEnvironment), collectErrors_Inh_GuardedExpressions :: (TypeErrors), collectWarnings_Inh_GuardedExpressions :: (Warnings), counter_Inh_GuardedExpressions :: (Int), currentChunk_Inh_GuardedExpressions :: (Int), dictionaryEnvironment_Inh_GuardedExpressions :: (DictionaryEnvironment), importEnvironment_Inh_GuardedExpressions :: (ImportEnvironment), matchIO_Inh_GuardedExpressions :: (IO ()), monos_Inh_GuardedExpressions :: (Monos), namesInScope_Inh_GuardedExpressions :: (Names), numberOfGuards_Inh_GuardedExpressions :: (Int), open_Inh_GuardedExpressions :: (Bool), orderedTypeSynonyms_Inh_GuardedExpressions :: (OrderedTypeSynonyms), parentTree_Inh_GuardedExpressions :: (InfoTree), patternMatchWarnings_Inh_GuardedExpressions :: ([Warning]), substitution_Inh_GuardedExpressions :: (FixpointSubstitution), typeschemeMap_Inh_GuardedExpressions :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_GuardedExpressions :: (Int), uniqueSecondRound_Inh_GuardedExpressions :: (Int) } +data Syn_GuardedExpressions = Syn_GuardedExpressions { assumptions_Syn_GuardedExpressions :: (Assumptions), betaUnique_Syn_GuardedExpressions :: (Int), collectErrors_Syn_GuardedExpressions :: (TypeErrors), collectInstances_Syn_GuardedExpressions :: ([(Name, Instance)]), collectWarnings_Syn_GuardedExpressions :: (Warnings), constraintslist_Syn_GuardedExpressions :: (ConstraintSets), counter_Syn_GuardedExpressions :: (Int), dictionaryEnvironment_Syn_GuardedExpressions :: (DictionaryEnvironment), fallthrough_Syn_GuardedExpressions :: (Bool), infoTrees_Syn_GuardedExpressions :: (InfoTrees), matchIO_Syn_GuardedExpressions :: (IO ()), patternMatchWarnings_Syn_GuardedExpressions :: ([Warning]), self_Syn_GuardedExpressions :: (GuardedExpressions), unboundNames_Syn_GuardedExpressions :: (Names), uniqueChunk_Syn_GuardedExpressions :: (Int), uniqueSecondRound_Syn_GuardedExpressions :: (Int) } +{-# INLINABLE wrap_GuardedExpressions #-} +wrap_GuardedExpressions :: T_GuardedExpressions -> Inh_GuardedExpressions -> (Syn_GuardedExpressions ) +wrap_GuardedExpressions (T_GuardedExpressions act) (Inh_GuardedExpressions _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsInumberOfGuards _lhsIopen _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpressions_vIn64 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsInumberOfGuards _lhsIopen _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound + (T_GuardedExpressions_vOut64 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOfallthrough _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) <- return (inv_GuardedExpressions_s65 sem arg) + return (Syn_GuardedExpressions _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOfallthrough _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) + ) + +-- cata +{-# NOINLINE sem_GuardedExpressions #-} +sem_GuardedExpressions :: GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions list = Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list) + +-- semantic domain +newtype T_GuardedExpressions = T_GuardedExpressions { + attach_T_GuardedExpressions :: Identity (T_GuardedExpressions_s65 ) + } +newtype T_GuardedExpressions_s65 = C_GuardedExpressions_s65 { + inv_GuardedExpressions_s65 :: (T_GuardedExpressions_v64 ) + } +data T_GuardedExpressions_s66 = C_GuardedExpressions_s66 +type T_GuardedExpressions_v64 = (T_GuardedExpressions_vIn64 ) -> (T_GuardedExpressions_vOut64 ) +data T_GuardedExpressions_vIn64 = T_GuardedExpressions_vIn64 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Tp) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (Int) (Bool) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Int) (Int) +data T_GuardedExpressions_vOut64 = T_GuardedExpressions_vOut64 (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSets) (Int) (DictionaryEnvironment) (Bool) (InfoTrees) (IO ()) ([Warning]) (GuardedExpressions) (Names) (Int) (Int) +{-# NOINLINE sem_GuardedExpressions_Cons #-} +sem_GuardedExpressions_Cons :: T_GuardedExpression -> T_GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions_Cons arg_hd_ arg_tl_ = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsInumberOfGuards _lhsIopen _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _hdX62 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpression (arg_hd_)) + _tlX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_tl_)) + (T_GuardedExpression_vOut61 _hdIassumptions _hdIbetaUnique _hdIcollectErrors _hdIcollectInstances _hdIcollectWarnings _hdIconstraints _hdIcounter _hdIdictionaryEnvironment _hdIfallthrough _hdIinfoTrees _hdImatchIO _hdIpatternMatchWarnings _hdIrange _hdIself _hdIunboundNames _hdIuniqueChunk _hdIuniqueSecondRound _hdIunrwar) = inv_GuardedExpression_s62 _hdX62 (T_GuardedExpression_vIn61 _hdOallPatterns _hdOallTypeSchemes _hdOavailablePredicates _hdObetaRight _hdObetaUnique _hdOclassEnvironment _hdOcollectErrors _hdOcollectWarnings _hdOcounter _hdOcurrentChunk _hdOdictionaryEnvironment _hdOimportEnvironment _hdOmatchIO _hdOmonos _hdOnamesInScope _hdOnumberOfGuards _hdOorderedTypeSynonyms _hdOparentTree _hdOpatternMatchWarnings _hdOsubstitution _hdOtypeschemeMap _hdOuniqueChunk _hdOuniqueSecondRound) + (T_GuardedExpressions_vOut64 _tlIassumptions _tlIbetaUnique _tlIcollectErrors _tlIcollectInstances _tlIcollectWarnings _tlIconstraintslist _tlIcounter _tlIdictionaryEnvironment _tlIfallthrough _tlIinfoTrees _tlImatchIO _tlIpatternMatchWarnings _tlIself _tlIunboundNames _tlIuniqueChunk _tlIuniqueSecondRound) = inv_GuardedExpressions_s65 _tlX65 (T_GuardedExpressions_vIn64 _tlOallPatterns _tlOallTypeSchemes _tlOavailablePredicates _tlObetaRight _tlObetaUnique _tlOclassEnvironment _tlOcollectErrors _tlOcollectWarnings _tlOcounter _tlOcurrentChunk _tlOdictionaryEnvironment _tlOimportEnvironment _tlOmatchIO _tlOmonos _tlOnamesInScope _tlOnumberOfGuards _tlOopen _tlOorderedTypeSynonyms _tlOparentTree _tlOpatternMatchWarnings _tlOsubstitution _tlOtypeschemeMap _tlOuniqueChunk _tlOuniqueSecondRound) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2320 _hdIassumptions _tlIassumptions + _lhsOconstraintslist :: ConstraintSets + _lhsOconstraintslist = rule2321 _hdIconstraints _tlIconstraintslist + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2322 _hdIinfoTrees _tlIinfoTrees + _lhsOfallthrough :: Bool + _lhsOfallthrough = rule2323 _hdIfallthrough _tlIfallthrough + _tlOopen = rule2324 _hdIfallthrough _lhsIopen + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2325 _hdIunrwar _lhsIopen _tlIpatternMatchWarnings + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2326 _hdIcollectInstances _tlIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2327 _hdIunboundNames _tlIunboundNames + _self = rule2328 _hdIself _tlIself + _lhsOself :: GuardedExpressions + _lhsOself = rule2329 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2330 _tlIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2331 _tlIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2332 _tlIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule2333 _tlIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2334 _tlIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2335 _tlImatchIO + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2336 _tlIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule2337 _tlIuniqueSecondRound + _hdOallPatterns = rule2338 _lhsIallPatterns + _hdOallTypeSchemes = rule2339 _lhsIallTypeSchemes + _hdOavailablePredicates = rule2340 _lhsIavailablePredicates + _hdObetaRight = rule2341 _lhsIbetaRight + _hdObetaUnique = rule2342 _lhsIbetaUnique + _hdOclassEnvironment = rule2343 _lhsIclassEnvironment + _hdOcollectErrors = rule2344 _lhsIcollectErrors + _hdOcollectWarnings = rule2345 _lhsIcollectWarnings + _hdOcounter = rule2346 _lhsIcounter + _hdOcurrentChunk = rule2347 _lhsIcurrentChunk + _hdOdictionaryEnvironment = rule2348 _lhsIdictionaryEnvironment + _hdOimportEnvironment = rule2349 _lhsIimportEnvironment + _hdOmatchIO = rule2350 _lhsImatchIO + _hdOmonos = rule2351 _lhsImonos + _hdOnamesInScope = rule2352 _lhsInamesInScope + _hdOnumberOfGuards = rule2353 _lhsInumberOfGuards + _hdOorderedTypeSynonyms = rule2354 _lhsIorderedTypeSynonyms + _hdOparentTree = rule2355 _lhsIparentTree + _hdOpatternMatchWarnings = rule2356 _lhsIpatternMatchWarnings + _hdOsubstitution = rule2357 _lhsIsubstitution + _hdOtypeschemeMap = rule2358 _lhsItypeschemeMap + _hdOuniqueChunk = rule2359 _lhsIuniqueChunk + _hdOuniqueSecondRound = rule2360 _lhsIuniqueSecondRound + _tlOallPatterns = rule2361 _lhsIallPatterns + _tlOallTypeSchemes = rule2362 _lhsIallTypeSchemes + _tlOavailablePredicates = rule2363 _lhsIavailablePredicates + _tlObetaRight = rule2364 _lhsIbetaRight + _tlObetaUnique = rule2365 _hdIbetaUnique + _tlOclassEnvironment = rule2366 _lhsIclassEnvironment + _tlOcollectErrors = rule2367 _hdIcollectErrors + _tlOcollectWarnings = rule2368 _hdIcollectWarnings + _tlOcounter = rule2369 _hdIcounter + _tlOcurrentChunk = rule2370 _lhsIcurrentChunk + _tlOdictionaryEnvironment = rule2371 _hdIdictionaryEnvironment + _tlOimportEnvironment = rule2372 _lhsIimportEnvironment + _tlOmatchIO = rule2373 _hdImatchIO + _tlOmonos = rule2374 _lhsImonos + _tlOnamesInScope = rule2375 _lhsInamesInScope + _tlOnumberOfGuards = rule2376 _lhsInumberOfGuards + _tlOorderedTypeSynonyms = rule2377 _lhsIorderedTypeSynonyms + _tlOparentTree = rule2378 _lhsIparentTree + _tlOpatternMatchWarnings = rule2379 _hdIpatternMatchWarnings + _tlOsubstitution = rule2380 _lhsIsubstitution + _tlOtypeschemeMap = rule2381 _lhsItypeschemeMap + _tlOuniqueChunk = rule2382 _hdIuniqueChunk + _tlOuniqueSecondRound = rule2383 _hdIuniqueSecondRound + __result_ = T_GuardedExpressions_vOut64 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOfallthrough _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule2320 #-} + rule2320 = \ ((_hdIassumptions) :: Assumptions) ((_tlIassumptions) :: Assumptions) -> + _hdIassumptions `combine` _tlIassumptions + {-# INLINE rule2321 #-} + rule2321 = \ ((_hdIconstraints) :: ConstraintSet) ((_tlIconstraintslist) :: ConstraintSets) -> + _hdIconstraints : _tlIconstraintslist + {-# INLINE rule2322 #-} + rule2322 = \ ((_hdIinfoTrees) :: InfoTrees) ((_tlIinfoTrees) :: InfoTrees) -> + _hdIinfoTrees ++ _tlIinfoTrees + {-# INLINE rule2323 #-} + rule2323 = \ ((_hdIfallthrough) :: Bool) ((_tlIfallthrough) :: Bool) -> + _hdIfallthrough && _tlIfallthrough + {-# INLINE rule2324 #-} + rule2324 = \ ((_hdIfallthrough) :: Bool) ((_lhsIopen) :: Bool) -> + _hdIfallthrough && _lhsIopen + {-# INLINE rule2325 #-} + rule2325 = \ ((_hdIunrwar) :: Warning) ((_lhsIopen) :: Bool) ((_tlIpatternMatchWarnings) :: [Warning]) -> + (if not _lhsIopen then [_hdIunrwar] else []) + ++ _tlIpatternMatchWarnings + {-# INLINE rule2326 #-} + rule2326 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule2327 #-} + rule2327 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule2328 #-} + rule2328 = \ ((_hdIself) :: GuardedExpression) ((_tlIself) :: GuardedExpressions) -> + (:) _hdIself _tlIself + {-# INLINE rule2329 #-} + rule2329 = \ _self -> + _self + {-# INLINE rule2330 #-} + rule2330 = \ ((_tlIbetaUnique) :: Int) -> + _tlIbetaUnique + {-# INLINE rule2331 #-} + rule2331 = \ ((_tlIcollectErrors) :: TypeErrors) -> + _tlIcollectErrors + {-# INLINE rule2332 #-} + rule2332 = \ ((_tlIcollectWarnings) :: Warnings) -> + _tlIcollectWarnings + {-# INLINE rule2333 #-} + rule2333 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule2334 #-} + rule2334 = \ ((_tlIdictionaryEnvironment) :: DictionaryEnvironment) -> + _tlIdictionaryEnvironment + {-# INLINE rule2335 #-} + rule2335 = \ ((_tlImatchIO) :: IO ()) -> + _tlImatchIO + {-# INLINE rule2336 #-} + rule2336 = \ ((_tlIuniqueChunk) :: Int) -> + _tlIuniqueChunk + {-# INLINE rule2337 #-} + rule2337 = \ ((_tlIuniqueSecondRound) :: Int) -> + _tlIuniqueSecondRound + {-# INLINE rule2338 #-} + rule2338 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule2339 #-} + rule2339 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule2340 #-} + rule2340 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule2341 #-} + rule2341 = \ ((_lhsIbetaRight) :: Tp) -> + _lhsIbetaRight + {-# INLINE rule2342 #-} + rule2342 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2343 #-} + rule2343 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2344 #-} + rule2344 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2345 #-} + rule2345 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2346 #-} + rule2346 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2347 #-} + rule2347 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule2348 #-} + rule2348 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2349 #-} + rule2349 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2350 #-} + rule2350 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2351 #-} + rule2351 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2352 #-} + rule2352 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2353 #-} + rule2353 = \ ((_lhsInumberOfGuards) :: Int) -> + _lhsInumberOfGuards + {-# INLINE rule2354 #-} + rule2354 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2355 #-} + rule2355 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2356 #-} + rule2356 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2357 #-} + rule2357 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule2358 #-} + rule2358 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule2359 #-} + rule2359 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule2360 #-} + rule2360 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule2361 #-} + rule2361 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule2362 #-} + rule2362 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule2363 #-} + rule2363 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule2364 #-} + rule2364 = \ ((_lhsIbetaRight) :: Tp) -> + _lhsIbetaRight + {-# INLINE rule2365 #-} + rule2365 = \ ((_hdIbetaUnique) :: Int) -> + _hdIbetaUnique + {-# INLINE rule2366 #-} + rule2366 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2367 #-} + rule2367 = \ ((_hdIcollectErrors) :: TypeErrors) -> + _hdIcollectErrors + {-# INLINE rule2368 #-} + rule2368 = \ ((_hdIcollectWarnings) :: Warnings) -> + _hdIcollectWarnings + {-# INLINE rule2369 #-} + rule2369 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule2370 #-} + rule2370 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule2371 #-} + rule2371 = \ ((_hdIdictionaryEnvironment) :: DictionaryEnvironment) -> + _hdIdictionaryEnvironment + {-# INLINE rule2372 #-} + rule2372 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2373 #-} + rule2373 = \ ((_hdImatchIO) :: IO ()) -> + _hdImatchIO + {-# INLINE rule2374 #-} + rule2374 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2375 #-} + rule2375 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2376 #-} + rule2376 = \ ((_lhsInumberOfGuards) :: Int) -> + _lhsInumberOfGuards + {-# INLINE rule2377 #-} + rule2377 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2378 #-} + rule2378 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2379 #-} + rule2379 = \ ((_hdIpatternMatchWarnings) :: [Warning]) -> + _hdIpatternMatchWarnings + {-# INLINE rule2380 #-} + rule2380 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule2381 #-} + rule2381 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule2382 #-} + rule2382 = \ ((_hdIuniqueChunk) :: Int) -> + _hdIuniqueChunk + {-# INLINE rule2383 #-} + rule2383 = \ ((_hdIuniqueSecondRound) :: Int) -> + _hdIuniqueSecondRound +{-# NOINLINE sem_GuardedExpressions_Nil #-} +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsInumberOfGuards _lhsIopen _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2384 () + _lhsOconstraintslist :: ConstraintSets + _lhsOconstraintslist = rule2385 () + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2386 () + _lhsOfallthrough :: Bool + _lhsOfallthrough = rule2387 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2388 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2389 () + _self = rule2390 () + _lhsOself :: GuardedExpressions + _lhsOself = rule2391 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2392 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2393 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2394 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule2395 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2396 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2397 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2398 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2399 _lhsIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule2400 _lhsIuniqueSecondRound + __result_ = T_GuardedExpressions_vOut64 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraintslist _lhsOcounter _lhsOdictionaryEnvironment _lhsOfallthrough _lhsOinfoTrees _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule2384 #-} + rule2384 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule2385 #-} + rule2385 = \ (_ :: ()) -> + [] + {-# INLINE rule2386 #-} + rule2386 = \ (_ :: ()) -> + [] + {-# INLINE rule2387 #-} + rule2387 = \ (_ :: ()) -> + True + {-# INLINE rule2388 #-} + rule2388 = \ (_ :: ()) -> + [] + {-# INLINE rule2389 #-} + rule2389 = \ (_ :: ()) -> + [] + {-# INLINE rule2390 #-} + rule2390 = \ (_ :: ()) -> + [] + {-# INLINE rule2391 #-} + rule2391 = \ _self -> + _self + {-# INLINE rule2392 #-} + rule2392 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2393 #-} + rule2393 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2394 #-} + rule2394 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2395 #-} + rule2395 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2396 #-} + rule2396 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2397 #-} + rule2397 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2398 #-} + rule2398 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2399 #-} + rule2399 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule2400 #-} + rule2400 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + +-- Import ------------------------------------------------------ +-- wrapper +data Inh_Import = Inh_Import { } +data Syn_Import = Syn_Import { self_Syn_Import :: (Import) } +{-# INLINABLE wrap_Import #-} +wrap_Import :: T_Import -> Inh_Import -> (Syn_Import ) +wrap_Import (T_Import act) (Inh_Import ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Import_vIn67 + (T_Import_vOut67 _lhsOself) <- return (inv_Import_s68 sem arg) + return (Syn_Import _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Import #-} +sem_Import :: Import -> T_Import +sem_Import ( Import_Variable range_ name_ ) = sem_Import_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Import ( Import_TypeOrClass range_ name_ names_ ) = sem_Import_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Import ( Import_TypeOrClassComplete range_ name_ ) = sem_Import_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Import = T_Import { + attach_T_Import :: Identity (T_Import_s68 ) + } +newtype T_Import_s68 = C_Import_s68 { + inv_Import_s68 :: (T_Import_v67 ) + } +data T_Import_s69 = C_Import_s69 +type T_Import_v67 = (T_Import_vIn67 ) -> (T_Import_vOut67 ) +data T_Import_vIn67 = T_Import_vIn67 +data T_Import_vOut67 = T_Import_vOut67 (Import) +{-# NOINLINE sem_Import_Variable #-} +sem_Import_Variable :: T_Range -> T_Name -> T_Import +sem_Import_Variable arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule2401 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule2402 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule2401 #-} + rule2401 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_Variable _rangeIself _nameIself + {-# INLINE rule2402 #-} + rule2402 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClass #-} +sem_Import_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Import +sem_Import_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _self = rule2403 _nameIself _namesIself _rangeIself + _lhsOself :: Import + _lhsOself = rule2404 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule2403 #-} + rule2403 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Import_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule2404 #-} + rule2404 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClassComplete #-} +sem_Import_TypeOrClassComplete :: T_Range -> T_Name -> T_Import +sem_Import_TypeOrClassComplete arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule2405 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule2406 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule2405 #-} + rule2405 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule2406 #-} + rule2406 = \ _self -> + _self + +-- ImportDeclaration ------------------------------------------- +-- wrapper +data Inh_ImportDeclaration = Inh_ImportDeclaration { } +data Syn_ImportDeclaration = Syn_ImportDeclaration { self_Syn_ImportDeclaration :: (ImportDeclaration) } +{-# INLINABLE wrap_ImportDeclaration #-} +wrap_ImportDeclaration :: T_ImportDeclaration -> Inh_ImportDeclaration -> (Syn_ImportDeclaration ) +wrap_ImportDeclaration (T_ImportDeclaration act) (Inh_ImportDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclaration_vIn70 + (T_ImportDeclaration_vOut70 _lhsOself) <- return (inv_ImportDeclaration_s71 sem arg) + return (Syn_ImportDeclaration _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclaration #-} +sem_ImportDeclaration :: ImportDeclaration -> T_ImportDeclaration +sem_ImportDeclaration ( ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ ) = sem_ImportDeclaration_Import ( sem_Range range_ ) qualified_ ( sem_Name name_ ) ( sem_MaybeName asname_ ) ( sem_MaybeImportSpecification importspecification_ ) +sem_ImportDeclaration ( ImportDeclaration_Empty range_ ) = sem_ImportDeclaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_ImportDeclaration = T_ImportDeclaration { + attach_T_ImportDeclaration :: Identity (T_ImportDeclaration_s71 ) + } +newtype T_ImportDeclaration_s71 = C_ImportDeclaration_s71 { + inv_ImportDeclaration_s71 :: (T_ImportDeclaration_v70 ) + } +data T_ImportDeclaration_s72 = C_ImportDeclaration_s72 +type T_ImportDeclaration_v70 = (T_ImportDeclaration_vIn70 ) -> (T_ImportDeclaration_vOut70 ) +data T_ImportDeclaration_vIn70 = T_ImportDeclaration_vIn70 +data T_ImportDeclaration_vOut70 = T_ImportDeclaration_vOut70 (ImportDeclaration) +{-# NOINLINE sem_ImportDeclaration_Import #-} +sem_ImportDeclaration_Import :: T_Range -> (Bool) -> T_Name -> T_MaybeName -> T_MaybeImportSpecification -> T_ImportDeclaration +sem_ImportDeclaration_Import arg_range_ arg_qualified_ arg_name_ arg_asname_ arg_importspecification_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _asnameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_asname_)) + _importspecificationX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeImportSpecification (arg_importspecification_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeName_vOut103 _asnameIself) = inv_MaybeName_s104 _asnameX104 (T_MaybeName_vIn103 ) + (T_MaybeImportSpecification_vOut97 _importspecificationIself) = inv_MaybeImportSpecification_s98 _importspecificationX98 (T_MaybeImportSpecification_vIn97 ) + _self = rule2407 _asnameIself _importspecificationIself _nameIself _rangeIself arg_qualified_ + _lhsOself :: ImportDeclaration + _lhsOself = rule2408 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule2407 #-} + rule2407 = \ ((_asnameIself) :: MaybeName) ((_importspecificationIself) :: MaybeImportSpecification) ((_nameIself) :: Name) ((_rangeIself) :: Range) qualified_ -> + ImportDeclaration_Import _rangeIself qualified_ _nameIself _asnameIself _importspecificationIself + {-# INLINE rule2408 #-} + rule2408 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclaration_Empty #-} +sem_ImportDeclaration_Empty :: T_Range -> T_ImportDeclaration +sem_ImportDeclaration_Empty arg_range_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule2409 _rangeIself + _lhsOself :: ImportDeclaration + _lhsOself = rule2410 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule2409 #-} + rule2409 = \ ((_rangeIself) :: Range) -> + ImportDeclaration_Empty _rangeIself + {-# INLINE rule2410 #-} + rule2410 = \ _self -> + _self + +-- ImportDeclarations ------------------------------------------ +-- wrapper +data Inh_ImportDeclarations = Inh_ImportDeclarations { } +data Syn_ImportDeclarations = Syn_ImportDeclarations { self_Syn_ImportDeclarations :: (ImportDeclarations) } +{-# INLINABLE wrap_ImportDeclarations #-} +wrap_ImportDeclarations :: T_ImportDeclarations -> Inh_ImportDeclarations -> (Syn_ImportDeclarations ) +wrap_ImportDeclarations (T_ImportDeclarations act) (Inh_ImportDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclarations_vIn73 + (T_ImportDeclarations_vOut73 _lhsOself) <- return (inv_ImportDeclarations_s74 sem arg) + return (Syn_ImportDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclarations #-} +sem_ImportDeclarations :: ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations list = Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list) + +-- semantic domain +newtype T_ImportDeclarations = T_ImportDeclarations { + attach_T_ImportDeclarations :: Identity (T_ImportDeclarations_s74 ) + } +newtype T_ImportDeclarations_s74 = C_ImportDeclarations_s74 { + inv_ImportDeclarations_s74 :: (T_ImportDeclarations_v73 ) + } +data T_ImportDeclarations_s75 = C_ImportDeclarations_s75 +type T_ImportDeclarations_v73 = (T_ImportDeclarations_vIn73 ) -> (T_ImportDeclarations_vOut73 ) +data T_ImportDeclarations_vIn73 = T_ImportDeclarations_vIn73 +data T_ImportDeclarations_vOut73 = T_ImportDeclarations_vOut73 (ImportDeclarations) +{-# NOINLINE sem_ImportDeclarations_Cons #-} +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> T_ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations_Cons arg_hd_ arg_tl_ = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _hdX71 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclaration (arg_hd_)) + _tlX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_tl_)) + (T_ImportDeclaration_vOut70 _hdIself) = inv_ImportDeclaration_s71 _hdX71 (T_ImportDeclaration_vIn70 ) + (T_ImportDeclarations_vOut73 _tlIself) = inv_ImportDeclarations_s74 _tlX74 (T_ImportDeclarations_vIn73 ) + _self = rule2411 _hdIself _tlIself + _lhsOself :: ImportDeclarations + _lhsOself = rule2412 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule2411 #-} + rule2411 = \ ((_hdIself) :: ImportDeclaration) ((_tlIself) :: ImportDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule2412 #-} + rule2412 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclarations_Nil #-} +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _self = rule2413 () + _lhsOself :: ImportDeclarations + _lhsOself = rule2414 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule2413 #-} + rule2413 = \ (_ :: ()) -> + [] + {-# INLINE rule2414 #-} + rule2414 = \ _self -> + _self + +-- ImportSpecification ----------------------------------------- +-- wrapper +data Inh_ImportSpecification = Inh_ImportSpecification { } +data Syn_ImportSpecification = Syn_ImportSpecification { self_Syn_ImportSpecification :: (ImportSpecification) } +{-# INLINABLE wrap_ImportSpecification #-} +wrap_ImportSpecification :: T_ImportSpecification -> Inh_ImportSpecification -> (Syn_ImportSpecification ) +wrap_ImportSpecification (T_ImportSpecification act) (Inh_ImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportSpecification_vIn76 + (T_ImportSpecification_vOut76 _lhsOself) <- return (inv_ImportSpecification_s77 sem arg) + return (Syn_ImportSpecification _lhsOself) + ) + +-- cata +{-# INLINE sem_ImportSpecification #-} +sem_ImportSpecification :: ImportSpecification -> T_ImportSpecification +sem_ImportSpecification ( ImportSpecification_Import range_ hiding_ imports_ ) = sem_ImportSpecification_Import ( sem_Range range_ ) hiding_ ( sem_Imports imports_ ) + +-- semantic domain +newtype T_ImportSpecification = T_ImportSpecification { + attach_T_ImportSpecification :: Identity (T_ImportSpecification_s77 ) + } +newtype T_ImportSpecification_s77 = C_ImportSpecification_s77 { + inv_ImportSpecification_s77 :: (T_ImportSpecification_v76 ) + } +data T_ImportSpecification_s78 = C_ImportSpecification_s78 +type T_ImportSpecification_v76 = (T_ImportSpecification_vIn76 ) -> (T_ImportSpecification_vOut76 ) +data T_ImportSpecification_vIn76 = T_ImportSpecification_vIn76 +data T_ImportSpecification_vOut76 = T_ImportSpecification_vOut76 (ImportSpecification) +{-# NOINLINE sem_ImportSpecification_Import #-} +sem_ImportSpecification_Import :: T_Range -> (Bool) -> T_Imports -> T_ImportSpecification +sem_ImportSpecification_Import arg_range_ arg_hiding_ arg_imports_ = T_ImportSpecification (return st77) where + {-# NOINLINE st77 #-} + st77 = let + v76 :: T_ImportSpecification_v76 + v76 = \ (T_ImportSpecification_vIn76 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importsX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_imports_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Imports_vOut79 _importsIself) = inv_Imports_s80 _importsX80 (T_Imports_vIn79 ) + _self = rule2415 _importsIself _rangeIself arg_hiding_ + _lhsOself :: ImportSpecification + _lhsOself = rule2416 _self + __result_ = T_ImportSpecification_vOut76 _lhsOself + in __result_ ) + in C_ImportSpecification_s77 v76 + {-# INLINE rule2415 #-} + rule2415 = \ ((_importsIself) :: Imports) ((_rangeIself) :: Range) hiding_ -> + ImportSpecification_Import _rangeIself hiding_ _importsIself + {-# INLINE rule2416 #-} + rule2416 = \ _self -> + _self + +-- Imports ----------------------------------------------------- +-- wrapper +data Inh_Imports = Inh_Imports { } +data Syn_Imports = Syn_Imports { self_Syn_Imports :: (Imports) } +{-# INLINABLE wrap_Imports #-} +wrap_Imports :: T_Imports -> Inh_Imports -> (Syn_Imports ) +wrap_Imports (T_Imports act) (Inh_Imports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Imports_vIn79 + (T_Imports_vOut79 _lhsOself) <- return (inv_Imports_s80 sem arg) + return (Syn_Imports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Imports #-} +sem_Imports :: Imports -> T_Imports +sem_Imports list = Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list) + +-- semantic domain +newtype T_Imports = T_Imports { + attach_T_Imports :: Identity (T_Imports_s80 ) + } +newtype T_Imports_s80 = C_Imports_s80 { + inv_Imports_s80 :: (T_Imports_v79 ) + } +data T_Imports_s81 = C_Imports_s81 +type T_Imports_v79 = (T_Imports_vIn79 ) -> (T_Imports_vOut79 ) +data T_Imports_vIn79 = T_Imports_vIn79 +data T_Imports_vOut79 = T_Imports_vOut79 (Imports) +{-# NOINLINE sem_Imports_Cons #-} +sem_Imports_Cons :: T_Import -> T_Imports -> T_Imports +sem_Imports_Cons arg_hd_ arg_tl_ = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _hdX68 = Control.Monad.Identity.runIdentity (attach_T_Import (arg_hd_)) + _tlX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_tl_)) + (T_Import_vOut67 _hdIself) = inv_Import_s68 _hdX68 (T_Import_vIn67 ) + (T_Imports_vOut79 _tlIself) = inv_Imports_s80 _tlX80 (T_Imports_vIn79 ) + _self = rule2417 _hdIself _tlIself + _lhsOself :: Imports + _lhsOself = rule2418 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule2417 #-} + rule2417 = \ ((_hdIself) :: Import) ((_tlIself) :: Imports) -> + (:) _hdIself _tlIself + {-# INLINE rule2418 #-} + rule2418 = \ _self -> + _self +{-# NOINLINE sem_Imports_Nil #-} +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _self = rule2419 () + _lhsOself :: Imports + _lhsOself = rule2420 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule2419 #-} + rule2419 = \ (_ :: ()) -> + [] + {-# INLINE rule2420 #-} + rule2420 = \ _self -> + _self + +-- LeftHandSide ------------------------------------------------ +-- wrapper +data Inh_LeftHandSide = Inh_LeftHandSide { betaUnique_Inh_LeftHandSide :: (Int), counter_Inh_LeftHandSide :: (Int), importEnvironment_Inh_LeftHandSide :: (ImportEnvironment), monos_Inh_LeftHandSide :: (Monos), namesInScope_Inh_LeftHandSide :: (Names), parentTree_Inh_LeftHandSide :: (InfoTree), patternMatchWarnings_Inh_LeftHandSide :: ([Warning]) } +data Syn_LeftHandSide = Syn_LeftHandSide { argcount_Syn_LeftHandSide :: (Int), betaUnique_Syn_LeftHandSide :: (Int), betas_Syn_LeftHandSide :: (Tps), constraints_Syn_LeftHandSide :: (ConstraintSet), counter_Syn_LeftHandSide :: (Int), elements_Syn_LeftHandSide :: ( [PatternElement] ), environment_Syn_LeftHandSide :: (PatternAssumptions), infoTrees_Syn_LeftHandSide :: (InfoTrees), name_Syn_LeftHandSide :: (Name), numberOfPatterns_Syn_LeftHandSide :: (Int), patVarNames_Syn_LeftHandSide :: (Names), patternMatchWarnings_Syn_LeftHandSide :: ([Warning]), self_Syn_LeftHandSide :: (LeftHandSide), unboundNames_Syn_LeftHandSide :: (Names) } +{-# INLINABLE wrap_LeftHandSide #-} +wrap_LeftHandSide :: T_LeftHandSide -> Inh_LeftHandSide -> (Syn_LeftHandSide ) +wrap_LeftHandSide (T_LeftHandSide act) (Inh_LeftHandSide _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_LeftHandSide_vIn82 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings + (T_LeftHandSide_vOut82 _lhsOargcount _lhsObetaUnique _lhsObetas _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTrees _lhsOname _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames) <- return (inv_LeftHandSide_s83 sem arg) + return (Syn_LeftHandSide _lhsOargcount _lhsObetaUnique _lhsObetas _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTrees _lhsOname _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_LeftHandSide #-} +sem_LeftHandSide :: LeftHandSide -> T_LeftHandSide +sem_LeftHandSide ( LeftHandSide_Function range_ name_ patterns_ ) = sem_LeftHandSide_Function ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_LeftHandSide ( LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ ) = sem_LeftHandSide_Infix ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name operator_ ) ( sem_Pattern rightPattern_ ) +sem_LeftHandSide ( LeftHandSide_Parenthesized range_ lefthandside_ patterns_ ) = sem_LeftHandSide_Parenthesized ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_Patterns patterns_ ) + +-- semantic domain +newtype T_LeftHandSide = T_LeftHandSide { + attach_T_LeftHandSide :: Identity (T_LeftHandSide_s83 ) + } +newtype T_LeftHandSide_s83 = C_LeftHandSide_s83 { + inv_LeftHandSide_s83 :: (T_LeftHandSide_v82 ) + } +data T_LeftHandSide_s84 = C_LeftHandSide_s84 +type T_LeftHandSide_v82 = (T_LeftHandSide_vIn82 ) -> (T_LeftHandSide_vOut82 ) +data T_LeftHandSide_vIn82 = T_LeftHandSide_vIn82 (Int) (Int) (ImportEnvironment) (Monos) (Names) (InfoTree) ([Warning]) +data T_LeftHandSide_vOut82 = T_LeftHandSide_vOut82 (Int) (Int) (Tps) (ConstraintSet) (Int) ( [PatternElement] ) (PatternAssumptions) (InfoTrees) (Name) (Int) (Names) ([Warning]) (LeftHandSide) (Names) +{-# NOINLINE sem_LeftHandSide_Function #-} +sem_LeftHandSide_Function :: T_Range -> T_Name -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Function arg_range_ arg_name_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIbetaUnique _patternsIbetas _patternsIconstraintslist _patternsIcounter _patternsIelementss _patternsIenvironment _patternsIinfoTrees _patternsInumberOfPatterns _patternsIpatVarNames _patternsIpatternMatchWarnings _patternsIself _patternsIunboundNames) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsObetaUnique _patternsOcounter _patternsOimportEnvironment _patternsOmonos _patternsOnamesInScope _patternsOparentTree _patternsOpatternMatchWarnings) + _lhsOname :: Name + _lhsOname = rule2421 _nameIself + _constraints = rule2422 _patternsIconstraintslist + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2423 _patternsIinfoTrees + _lhsOelements :: [PatternElement] + _lhsOelements = rule2424 _patternsIelementss + _lhsOargcount :: Int + _lhsOargcount = rule2425 _patternsIself + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2426 _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2427 _patternsIunboundNames + _self = rule2428 _nameIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule2429 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2430 _patternsIbetaUnique + _lhsObetas :: Tps + _lhsObetas = rule2431 _patternsIbetas + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2432 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2433 _patternsIcounter + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2434 _patternsIenvironment + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule2435 _patternsInumberOfPatterns + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2436 _patternsIpatternMatchWarnings + _patternsObetaUnique = rule2437 _lhsIbetaUnique + _patternsOcounter = rule2438 _lhsIcounter + _patternsOimportEnvironment = rule2439 _lhsIimportEnvironment + _patternsOmonos = rule2440 _lhsImonos + _patternsOnamesInScope = rule2441 _lhsInamesInScope + _patternsOparentTree = rule2442 _lhsIparentTree + _patternsOpatternMatchWarnings = rule2443 _lhsIpatternMatchWarnings + __result_ = T_LeftHandSide_vOut82 _lhsOargcount _lhsObetaUnique _lhsObetas _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTrees _lhsOname _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule2421 #-} + rule2421 = \ ((_nameIself) :: Name) -> + _nameIself + {-# INLINE rule2422 #-} + rule2422 = \ ((_patternsIconstraintslist) :: ConstraintSets) -> + Node _patternsIconstraintslist + {-# INLINE rule2423 #-} + rule2423 = \ ((_patternsIinfoTrees) :: InfoTrees) -> + _patternsIinfoTrees + {-# INLINE rule2424 #-} + rule2424 = \ ((_patternsIelementss) :: [ [PatternElement] ]) -> + concat _patternsIelementss + {-# INLINE rule2425 #-} + rule2425 = \ ((_patternsIself) :: Patterns) -> + length _patternsIself + {-# INLINE rule2426 #-} + rule2426 = \ ((_patternsIpatVarNames) :: Names) -> + _patternsIpatVarNames + {-# INLINE rule2427 #-} + rule2427 = \ ((_patternsIunboundNames) :: Names) -> + _patternsIunboundNames + {-# INLINE rule2428 #-} + rule2428 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Function _rangeIself _nameIself _patternsIself + {-# INLINE rule2429 #-} + rule2429 = \ _self -> + _self + {-# INLINE rule2430 #-} + rule2430 = \ ((_patternsIbetaUnique) :: Int) -> + _patternsIbetaUnique + {-# INLINE rule2431 #-} + rule2431 = \ ((_patternsIbetas) :: Tps) -> + _patternsIbetas + {-# INLINE rule2432 #-} + rule2432 = \ _constraints -> + _constraints + {-# INLINE rule2433 #-} + rule2433 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule2434 #-} + rule2434 = \ ((_patternsIenvironment) :: PatternAssumptions) -> + _patternsIenvironment + {-# INLINE rule2435 #-} + rule2435 = \ ((_patternsInumberOfPatterns) :: Int) -> + _patternsInumberOfPatterns + {-# INLINE rule2436 #-} + rule2436 = \ ((_patternsIpatternMatchWarnings) :: [Warning]) -> + _patternsIpatternMatchWarnings + {-# INLINE rule2437 #-} + rule2437 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2438 #-} + rule2438 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2439 #-} + rule2439 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2440 #-} + rule2440 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2441 #-} + rule2441 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2442 #-} + rule2442 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2443 #-} + rule2443 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_LeftHandSide_Infix #-} +sem_LeftHandSide_Infix :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_LeftHandSide +sem_LeftHandSide_Infix arg_range_ arg_leftPattern_ arg_operator_ arg_rightPattern_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _operatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_operator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIbeta _leftPatternIbetaUnique _leftPatternIconstraints _leftPatternIcounter _leftPatternIelements _leftPatternIenvironment _leftPatternIinfoTree _leftPatternIpatVarNames _leftPatternIpatternMatchWarnings _leftPatternIself _leftPatternIunboundNames) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 _leftPatternObetaUnique _leftPatternOcounter _leftPatternOimportEnvironment _leftPatternOmonos _leftPatternOnamesInScope _leftPatternOparentTree _leftPatternOpatternMatchWarnings) + (T_Name_vOut112 _operatorIself) = inv_Name_s113 _operatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIbeta _rightPatternIbetaUnique _rightPatternIconstraints _rightPatternIcounter _rightPatternIelements _rightPatternIenvironment _rightPatternIinfoTree _rightPatternIpatVarNames _rightPatternIpatternMatchWarnings _rightPatternIself _rightPatternIunboundNames) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 _rightPatternObetaUnique _rightPatternOcounter _rightPatternOimportEnvironment _rightPatternOmonos _rightPatternOnamesInScope _rightPatternOparentTree _rightPatternOpatternMatchWarnings) + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule2444 () + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2445 _leftPatternIenvironment _rightPatternIenvironment + _lhsObetas :: Tps + _lhsObetas = rule2446 _leftPatternIbeta _rightPatternIbeta + _lhsOname :: Name + _lhsOname = rule2447 _operatorIself + _constraints = rule2448 _leftPatternIconstraints _rightPatternIconstraints + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2449 _leftPatternIinfoTree _rightPatternIinfoTree + _lhsOelements :: [PatternElement] + _lhsOelements = rule2450 _leftPatternIelements _rightPatternIelements + _lhsOargcount :: Int + _lhsOargcount = rule2451 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2452 _leftPatternIpatVarNames _rightPatternIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2453 _leftPatternIunboundNames _rightPatternIunboundNames + _self = rule2454 _leftPatternIself _operatorIself _rangeIself _rightPatternIself + _lhsOself :: LeftHandSide + _lhsOself = rule2455 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2456 _rightPatternIbetaUnique + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2457 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2458 _rightPatternIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2459 _rightPatternIpatternMatchWarnings + _leftPatternObetaUnique = rule2460 _lhsIbetaUnique + _leftPatternOcounter = rule2461 _lhsIcounter + _leftPatternOimportEnvironment = rule2462 _lhsIimportEnvironment + _leftPatternOmonos = rule2463 _lhsImonos + _leftPatternOnamesInScope = rule2464 _lhsInamesInScope + _leftPatternOparentTree = rule2465 _lhsIparentTree + _leftPatternOpatternMatchWarnings = rule2466 _lhsIpatternMatchWarnings + _rightPatternObetaUnique = rule2467 _leftPatternIbetaUnique + _rightPatternOcounter = rule2468 _leftPatternIcounter + _rightPatternOimportEnvironment = rule2469 _lhsIimportEnvironment + _rightPatternOmonos = rule2470 _lhsImonos + _rightPatternOnamesInScope = rule2471 _lhsInamesInScope + _rightPatternOparentTree = rule2472 _lhsIparentTree + _rightPatternOpatternMatchWarnings = rule2473 _leftPatternIpatternMatchWarnings + __result_ = T_LeftHandSide_vOut82 _lhsOargcount _lhsObetaUnique _lhsObetas _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTrees _lhsOname _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule2444 #-} + rule2444 = \ (_ :: ()) -> + 2 + {-# INLINE rule2445 #-} + rule2445 = \ ((_leftPatternIenvironment) :: PatternAssumptions) ((_rightPatternIenvironment) :: PatternAssumptions) -> + _leftPatternIenvironment `M.union` _rightPatternIenvironment + {-# INLINE rule2446 #-} + rule2446 = \ ((_leftPatternIbeta) :: Tp) ((_rightPatternIbeta) :: Tp) -> + [_leftPatternIbeta,_rightPatternIbeta] + {-# INLINE rule2447 #-} + rule2447 = \ ((_operatorIself) :: Name) -> + _operatorIself + {-# INLINE rule2448 #-} + rule2448 = \ ((_leftPatternIconstraints) :: ConstraintSet) ((_rightPatternIconstraints) :: ConstraintSet) -> + Node [ _leftPatternIconstraints + , _rightPatternIconstraints + ] + {-# INLINE rule2449 #-} + rule2449 = \ ((_leftPatternIinfoTree) :: InfoTree) ((_rightPatternIinfoTree) :: InfoTree) -> + [_leftPatternIinfoTree, _rightPatternIinfoTree] + {-# INLINE rule2450 #-} + rule2450 = \ ((_leftPatternIelements) :: [PatternElement] ) ((_rightPatternIelements) :: [PatternElement] ) -> + _leftPatternIelements ++ _rightPatternIelements + {-# INLINE rule2451 #-} + rule2451 = \ (_ :: ()) -> + 2 + {-# INLINE rule2452 #-} + rule2452 = \ ((_leftPatternIpatVarNames) :: Names) ((_rightPatternIpatVarNames) :: Names) -> + _leftPatternIpatVarNames ++ _rightPatternIpatVarNames + {-# INLINE rule2453 #-} + rule2453 = \ ((_leftPatternIunboundNames) :: Names) ((_rightPatternIunboundNames) :: Names) -> + _leftPatternIunboundNames ++ _rightPatternIunboundNames + {-# INLINE rule2454 #-} + rule2454 = \ ((_leftPatternIself) :: Pattern) ((_operatorIself) :: Name) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + LeftHandSide_Infix _rangeIself _leftPatternIself _operatorIself _rightPatternIself + {-# INLINE rule2455 #-} + rule2455 = \ _self -> + _self + {-# INLINE rule2456 #-} + rule2456 = \ ((_rightPatternIbetaUnique) :: Int) -> + _rightPatternIbetaUnique + {-# INLINE rule2457 #-} + rule2457 = \ _constraints -> + _constraints + {-# INLINE rule2458 #-} + rule2458 = \ ((_rightPatternIcounter) :: Int) -> + _rightPatternIcounter + {-# INLINE rule2459 #-} + rule2459 = \ ((_rightPatternIpatternMatchWarnings) :: [Warning]) -> + _rightPatternIpatternMatchWarnings + {-# INLINE rule2460 #-} + rule2460 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2461 #-} + rule2461 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2462 #-} + rule2462 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2463 #-} + rule2463 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2464 #-} + rule2464 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2465 #-} + rule2465 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2466 #-} + rule2466 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2467 #-} + rule2467 = \ ((_leftPatternIbetaUnique) :: Int) -> + _leftPatternIbetaUnique + {-# INLINE rule2468 #-} + rule2468 = \ ((_leftPatternIcounter) :: Int) -> + _leftPatternIcounter + {-# INLINE rule2469 #-} + rule2469 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2470 #-} + rule2470 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2471 #-} + rule2471 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2472 #-} + rule2472 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2473 #-} + rule2473 = \ ((_leftPatternIpatternMatchWarnings) :: [Warning]) -> + _leftPatternIpatternMatchWarnings +{-# NOINLINE sem_LeftHandSide_Parenthesized #-} +sem_LeftHandSide_Parenthesized :: T_Range -> T_LeftHandSide -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Parenthesized arg_range_ arg_lefthandside_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIargcount _lefthandsideIbetaUnique _lefthandsideIbetas _lefthandsideIconstraints _lefthandsideIcounter _lefthandsideIelements _lefthandsideIenvironment _lefthandsideIinfoTrees _lefthandsideIname _lefthandsideInumberOfPatterns _lefthandsideIpatVarNames _lefthandsideIpatternMatchWarnings _lefthandsideIself _lefthandsideIunboundNames) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 _lefthandsideObetaUnique _lefthandsideOcounter _lefthandsideOimportEnvironment _lefthandsideOmonos _lefthandsideOnamesInScope _lefthandsideOparentTree _lefthandsideOpatternMatchWarnings) + (T_Patterns_vOut121 _patternsIbetaUnique _patternsIbetas _patternsIconstraintslist _patternsIcounter _patternsIelementss _patternsIenvironment _patternsIinfoTrees _patternsInumberOfPatterns _patternsIpatVarNames _patternsIpatternMatchWarnings _patternsIself _patternsIunboundNames) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsObetaUnique _patternsOcounter _patternsOimportEnvironment _patternsOmonos _patternsOnamesInScope _patternsOparentTree _patternsOpatternMatchWarnings) + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule2474 _lefthandsideInumberOfPatterns _patternsInumberOfPatterns + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2475 _lefthandsideIenvironment _patternsIenvironment + _lhsObetas :: Tps + _lhsObetas = rule2476 _lefthandsideIbetas _patternsIbetas + _constraints = rule2477 _lefthandsideIconstraints _patternsIconstraintslist + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2478 _lefthandsideIinfoTrees _patternsIinfoTrees + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2479 _lefthandsideIpatVarNames _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2480 _lefthandsideIunboundNames _patternsIunboundNames + _self = rule2481 _lefthandsideIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule2482 _self + _lhsOargcount :: Int + _lhsOargcount = rule2483 _lefthandsideIargcount + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2484 _patternsIbetaUnique + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2485 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2486 _patternsIcounter + _lhsOelements :: [PatternElement] + _lhsOelements = rule2487 _lefthandsideIelements + _lhsOname :: Name + _lhsOname = rule2488 _lefthandsideIname + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2489 _patternsIpatternMatchWarnings + _lefthandsideObetaUnique = rule2490 _lhsIbetaUnique + _lefthandsideOcounter = rule2491 _lhsIcounter + _lefthandsideOimportEnvironment = rule2492 _lhsIimportEnvironment + _lefthandsideOmonos = rule2493 _lhsImonos + _lefthandsideOnamesInScope = rule2494 _lhsInamesInScope + _lefthandsideOparentTree = rule2495 _lhsIparentTree + _lefthandsideOpatternMatchWarnings = rule2496 _lhsIpatternMatchWarnings + _patternsObetaUnique = rule2497 _lefthandsideIbetaUnique + _patternsOcounter = rule2498 _lefthandsideIcounter + _patternsOimportEnvironment = rule2499 _lhsIimportEnvironment + _patternsOmonos = rule2500 _lhsImonos + _patternsOnamesInScope = rule2501 _lhsInamesInScope + _patternsOparentTree = rule2502 _lhsIparentTree + _patternsOpatternMatchWarnings = rule2503 _lefthandsideIpatternMatchWarnings + __result_ = T_LeftHandSide_vOut82 _lhsOargcount _lhsObetaUnique _lhsObetas _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTrees _lhsOname _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule2474 #-} + rule2474 = \ ((_lefthandsideInumberOfPatterns) :: Int) ((_patternsInumberOfPatterns) :: Int) -> + _lefthandsideInumberOfPatterns + _patternsInumberOfPatterns + {-# INLINE rule2475 #-} + rule2475 = \ ((_lefthandsideIenvironment) :: PatternAssumptions) ((_patternsIenvironment) :: PatternAssumptions) -> + _lefthandsideIenvironment `M.union` _patternsIenvironment + {-# INLINE rule2476 #-} + rule2476 = \ ((_lefthandsideIbetas) :: Tps) ((_patternsIbetas) :: Tps) -> + _lefthandsideIbetas ++ _patternsIbetas + {-# INLINE rule2477 #-} + rule2477 = \ ((_lefthandsideIconstraints) :: ConstraintSet) ((_patternsIconstraintslist) :: ConstraintSets) -> + Node ( _lefthandsideIconstraints : _patternsIconstraintslist ) + {-# INLINE rule2478 #-} + rule2478 = \ ((_lefthandsideIinfoTrees) :: InfoTrees) ((_patternsIinfoTrees) :: InfoTrees) -> + _lefthandsideIinfoTrees ++ _patternsIinfoTrees + {-# INLINE rule2479 #-} + rule2479 = \ ((_lefthandsideIpatVarNames) :: Names) ((_patternsIpatVarNames) :: Names) -> + _lefthandsideIpatVarNames ++ _patternsIpatVarNames + {-# INLINE rule2480 #-} + rule2480 = \ ((_lefthandsideIunboundNames) :: Names) ((_patternsIunboundNames) :: Names) -> + _lefthandsideIunboundNames ++ _patternsIunboundNames + {-# INLINE rule2481 #-} + rule2481 = \ ((_lefthandsideIself) :: LeftHandSide) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Parenthesized _rangeIself _lefthandsideIself _patternsIself + {-# INLINE rule2482 #-} + rule2482 = \ _self -> + _self + {-# INLINE rule2483 #-} + rule2483 = \ ((_lefthandsideIargcount) :: Int) -> + _lefthandsideIargcount + {-# INLINE rule2484 #-} + rule2484 = \ ((_patternsIbetaUnique) :: Int) -> + _patternsIbetaUnique + {-# INLINE rule2485 #-} + rule2485 = \ _constraints -> + _constraints + {-# INLINE rule2486 #-} + rule2486 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule2487 #-} + rule2487 = \ ((_lefthandsideIelements) :: [PatternElement] ) -> + _lefthandsideIelements + {-# INLINE rule2488 #-} + rule2488 = \ ((_lefthandsideIname) :: Name) -> + _lefthandsideIname + {-# INLINE rule2489 #-} + rule2489 = \ ((_patternsIpatternMatchWarnings) :: [Warning]) -> + _patternsIpatternMatchWarnings + {-# INLINE rule2490 #-} + rule2490 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2491 #-} + rule2491 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2492 #-} + rule2492 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2493 #-} + rule2493 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2494 #-} + rule2494 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2495 #-} + rule2495 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2496 #-} + rule2496 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2497 #-} + rule2497 = \ ((_lefthandsideIbetaUnique) :: Int) -> + _lefthandsideIbetaUnique + {-# INLINE rule2498 #-} + rule2498 = \ ((_lefthandsideIcounter) :: Int) -> + _lefthandsideIcounter + {-# INLINE rule2499 #-} + rule2499 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2500 #-} + rule2500 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2501 #-} + rule2501 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2502 #-} + rule2502 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2503 #-} + rule2503 = \ ((_lefthandsideIpatternMatchWarnings) :: [Warning]) -> + _lefthandsideIpatternMatchWarnings + +-- Literal ----------------------------------------------------- +-- wrapper +data Inh_Literal = Inh_Literal { } +data Syn_Literal = Syn_Literal { elements_Syn_Literal :: ( [PatternElement] ), literalType_Syn_Literal :: (Tp), self_Syn_Literal :: (Literal) } +{-# INLINABLE wrap_Literal #-} +wrap_Literal :: T_Literal -> Inh_Literal -> (Syn_Literal ) +wrap_Literal (T_Literal act) (Inh_Literal ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Literal_vIn85 + (T_Literal_vOut85 _lhsOelements _lhsOliteralType _lhsOself) <- return (inv_Literal_s86 sem arg) + return (Syn_Literal _lhsOelements _lhsOliteralType _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Literal #-} +sem_Literal :: Literal -> T_Literal +sem_Literal ( Literal_Int range_ value_ ) = sem_Literal_Int ( sem_Range range_ ) value_ +sem_Literal ( Literal_Char range_ value_ ) = sem_Literal_Char ( sem_Range range_ ) value_ +sem_Literal ( Literal_Float range_ value_ ) = sem_Literal_Float ( sem_Range range_ ) value_ +sem_Literal ( Literal_String range_ value_ ) = sem_Literal_String ( sem_Range range_ ) value_ + +-- semantic domain +newtype T_Literal = T_Literal { + attach_T_Literal :: Identity (T_Literal_s86 ) + } +newtype T_Literal_s86 = C_Literal_s86 { + inv_Literal_s86 :: (T_Literal_v85 ) + } +data T_Literal_s87 = C_Literal_s87 +type T_Literal_v85 = (T_Literal_vIn85 ) -> (T_Literal_vOut85 ) +data T_Literal_vIn85 = T_Literal_vIn85 +data T_Literal_vOut85 = T_Literal_vOut85 ( [PatternElement] ) (Tp) (Literal) +{-# NOINLINE sem_Literal_Int #-} +sem_Literal_Int :: T_Range -> (String) -> T_Literal +sem_Literal_Int arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOliteralType :: Tp + _lhsOliteralType = rule2504 () + _lhsOelements :: [PatternElement] + _lhsOelements = rule2505 arg_value_ + _self = rule2506 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule2507 _self + __result_ = T_Literal_vOut85 _lhsOelements _lhsOliteralType _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule2504 #-} + rule2504 = \ (_ :: ()) -> + intType + {-# INLINE rule2505 #-} + rule2505 = \ value_ -> + [InfiniteElement value_] + {-# INLINE rule2506 #-} + rule2506 = \ ((_rangeIself) :: Range) value_ -> + Literal_Int _rangeIself value_ + {-# INLINE rule2507 #-} + rule2507 = \ _self -> + _self +{-# NOINLINE sem_Literal_Char #-} +sem_Literal_Char :: T_Range -> (String) -> T_Literal +sem_Literal_Char arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOliteralType :: Tp + _lhsOliteralType = rule2508 () + _lhsOelements :: [PatternElement] + _lhsOelements = rule2509 arg_value_ + _self = rule2510 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule2511 _self + __result_ = T_Literal_vOut85 _lhsOelements _lhsOliteralType _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule2508 #-} + rule2508 = \ (_ :: ()) -> + charType + {-# INLINE rule2509 #-} + rule2509 = \ value_ -> + [InfiniteElement value_] + {-# INLINE rule2510 #-} + rule2510 = \ ((_rangeIself) :: Range) value_ -> + Literal_Char _rangeIself value_ + {-# INLINE rule2511 #-} + rule2511 = \ _self -> + _self +{-# NOINLINE sem_Literal_Float #-} +sem_Literal_Float :: T_Range -> (String) -> T_Literal +sem_Literal_Float arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOliteralType :: Tp + _lhsOliteralType = rule2512 () + _lhsOelements :: [PatternElement] + _lhsOelements = rule2513 arg_value_ + _self = rule2514 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule2515 _self + __result_ = T_Literal_vOut85 _lhsOelements _lhsOliteralType _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule2512 #-} + rule2512 = \ (_ :: ()) -> + floatType + {-# INLINE rule2513 #-} + rule2513 = \ value_ -> + [InfiniteElement value_] + {-# INLINE rule2514 #-} + rule2514 = \ ((_rangeIself) :: Range) value_ -> + Literal_Float _rangeIself value_ + {-# INLINE rule2515 #-} + rule2515 = \ _self -> + _self +{-# NOINLINE sem_Literal_String #-} +sem_Literal_String :: T_Range -> (String) -> T_Literal +sem_Literal_String arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOliteralType :: Tp + _lhsOliteralType = rule2516 () + _lhsOelements :: [PatternElement] + _lhsOelements = rule2517 arg_value_ + _self = rule2518 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule2519 _self + __result_ = T_Literal_vOut85 _lhsOelements _lhsOliteralType _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule2516 #-} + rule2516 = \ (_ :: ()) -> + stringType + {-# INLINE rule2517 #-} + rule2517 = \ value_ -> + stringPat value_ + {-# INLINE rule2518 #-} + rule2518 = \ ((_rangeIself) :: Range) value_ -> + Literal_String _rangeIself value_ + {-# INLINE rule2519 #-} + rule2519 = \ _self -> + _self + +-- MaybeDeclarations ------------------------------------------- +-- wrapper +data Inh_MaybeDeclarations = Inh_MaybeDeclarations { allPatterns_Inh_MaybeDeclarations :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_MaybeDeclarations :: (M.Map NameWithRange TpScheme), assumptions_Inh_MaybeDeclarations :: (Assumptions), availablePredicates_Inh_MaybeDeclarations :: (Predicates), betaUnique_Inh_MaybeDeclarations :: (Int), classEnvironment_Inh_MaybeDeclarations :: (ClassEnvironment), collectErrors_Inh_MaybeDeclarations :: (TypeErrors), collectWarnings_Inh_MaybeDeclarations :: (Warnings), constraints_Inh_MaybeDeclarations :: (ConstraintSet), counter_Inh_MaybeDeclarations :: (Int), currentChunk_Inh_MaybeDeclarations :: (Int), dictionaryEnvironment_Inh_MaybeDeclarations :: (DictionaryEnvironment), importEnvironment_Inh_MaybeDeclarations :: (ImportEnvironment), matchIO_Inh_MaybeDeclarations :: (IO ()), monos_Inh_MaybeDeclarations :: (Monos), namesInScope_Inh_MaybeDeclarations :: (Names), orderedTypeSynonyms_Inh_MaybeDeclarations :: (OrderedTypeSynonyms), parentTree_Inh_MaybeDeclarations :: (InfoTree), patternMatchWarnings_Inh_MaybeDeclarations :: ([Warning]), substitution_Inh_MaybeDeclarations :: (FixpointSubstitution), typeschemeMap_Inh_MaybeDeclarations :: (M.Map Int (Scheme Predicates)), unboundNames_Inh_MaybeDeclarations :: (Names), uniqueChunk_Inh_MaybeDeclarations :: (Int) } +data Syn_MaybeDeclarations = Syn_MaybeDeclarations { assumptions_Syn_MaybeDeclarations :: (Assumptions), betaUnique_Syn_MaybeDeclarations :: (Int), collectErrors_Syn_MaybeDeclarations :: (TypeErrors), collectInstances_Syn_MaybeDeclarations :: ([(Name, Instance)]), collectWarnings_Syn_MaybeDeclarations :: (Warnings), constraints_Syn_MaybeDeclarations :: (ConstraintSet), counter_Syn_MaybeDeclarations :: (Int), dictionaryEnvironment_Syn_MaybeDeclarations :: (DictionaryEnvironment), infoTrees_Syn_MaybeDeclarations :: (InfoTrees), localTypes_Syn_MaybeDeclarations :: (M.Map NameWithRange TpScheme), matchIO_Syn_MaybeDeclarations :: (IO ()), namesInScope_Syn_MaybeDeclarations :: (Names), patternMatchWarnings_Syn_MaybeDeclarations :: ([Warning]), self_Syn_MaybeDeclarations :: (MaybeDeclarations), unboundNames_Syn_MaybeDeclarations :: (Names), uniqueChunk_Syn_MaybeDeclarations :: (Int) } +{-# INLINABLE wrap_MaybeDeclarations #-} +wrap_MaybeDeclarations :: T_MaybeDeclarations -> Inh_MaybeDeclarations -> (Syn_MaybeDeclarations ) +wrap_MaybeDeclarations (T_MaybeDeclarations act) (Inh_MaybeDeclarations _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeDeclarations_vIn88 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk + (T_MaybeDeclarations_vOut88 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOlocalTypes _lhsOmatchIO _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk) <- return (inv_MaybeDeclarations_s89 sem arg) + return (Syn_MaybeDeclarations _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOlocalTypes _lhsOmatchIO _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk) + ) + +-- cata +{-# NOINLINE sem_MaybeDeclarations #-} +sem_MaybeDeclarations :: MaybeDeclarations -> T_MaybeDeclarations +sem_MaybeDeclarations ( MaybeDeclarations_Nothing ) = sem_MaybeDeclarations_Nothing +sem_MaybeDeclarations ( MaybeDeclarations_Just declarations_ ) = sem_MaybeDeclarations_Just ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_MaybeDeclarations = T_MaybeDeclarations { + attach_T_MaybeDeclarations :: Identity (T_MaybeDeclarations_s89 ) + } +newtype T_MaybeDeclarations_s89 = C_MaybeDeclarations_s89 { + inv_MaybeDeclarations_s89 :: (T_MaybeDeclarations_v88 ) + } +data T_MaybeDeclarations_s90 = C_MaybeDeclarations_s90 +type T_MaybeDeclarations_v88 = (T_MaybeDeclarations_vIn88 ) -> (T_MaybeDeclarations_vOut88 ) +data T_MaybeDeclarations_vIn88 = T_MaybeDeclarations_vIn88 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Assumptions) (Predicates) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (ConstraintSet) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Names) (Int) +data T_MaybeDeclarations_vOut88 = T_MaybeDeclarations_vOut88 (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (DictionaryEnvironment) (InfoTrees) (M.Map NameWithRange TpScheme) (IO ()) (Names) ([Warning]) (MaybeDeclarations) (Names) (Int) +{-# NOINLINE sem_MaybeDeclarations_Nothing #-} +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk) -> ( let + _lhsOlocalTypes :: M.Map NameWithRange TpScheme + _lhsOlocalTypes = rule2520 () + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2521 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2522 () + _self = rule2523 () + _lhsOself :: MaybeDeclarations + _lhsOself = rule2524 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2525 _lhsIassumptions + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2526 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2527 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2528 _lhsIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2529 _lhsIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule2530 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2531 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2532 _lhsImatchIO + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2533 _lhsInamesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2534 _lhsIpatternMatchWarnings + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2535 _lhsIunboundNames + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2536 _lhsIuniqueChunk + __result_ = T_MaybeDeclarations_vOut88 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOlocalTypes _lhsOmatchIO _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule2520 #-} + rule2520 = \ (_ :: ()) -> + M.empty + {-# INLINE rule2521 #-} + rule2521 = \ (_ :: ()) -> + [] + {-# INLINE rule2522 #-} + rule2522 = \ (_ :: ()) -> + [] + {-# INLINE rule2523 #-} + rule2523 = \ (_ :: ()) -> + MaybeDeclarations_Nothing + {-# INLINE rule2524 #-} + rule2524 = \ _self -> + _self + {-# INLINE rule2525 #-} + rule2525 = \ ((_lhsIassumptions) :: Assumptions) -> + _lhsIassumptions + {-# INLINE rule2526 #-} + rule2526 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2527 #-} + rule2527 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2528 #-} + rule2528 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2529 #-} + rule2529 = \ ((_lhsIconstraints) :: ConstraintSet) -> + _lhsIconstraints + {-# INLINE rule2530 #-} + rule2530 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2531 #-} + rule2531 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2532 #-} + rule2532 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2533 #-} + rule2533 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2534 #-} + rule2534 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2535 #-} + rule2535 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule2536 #-} + rule2536 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_MaybeDeclarations_Just #-} +sem_MaybeDeclarations_Just :: T_Declarations -> T_MaybeDeclarations +sem_MaybeDeclarations_Just arg_declarations_ = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk) -> ( let + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Declarations_vOut31 _declarationsIbetaUnique _declarationsIbindingGroups _declarationsIcollectErrors _declarationsIcollectInstances _declarationsIcollectWarnings _declarationsIcounter _declarationsIdeclVarNames _declarationsIdictionaryEnvironment _declarationsIinfoTrees _declarationsImatchIO _declarationsIpatternMatchWarnings _declarationsIrestrictedNames _declarationsIself _declarationsIsimplePatNames _declarationsItypeSignatures _declarationsIunboundNames _declarationsIuniqueChunk) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOallPatterns _declarationsOallTypeSchemes _declarationsOavailablePredicates _declarationsObetaUnique _declarationsObindingGroups _declarationsOclassEnvironment _declarationsOcollectErrors _declarationsOcollectWarnings _declarationsOcounter _declarationsOcurrentChunk _declarationsOdictionaryEnvironment _declarationsOimportEnvironment _declarationsOinheritedBDG _declarationsOmatchIO _declarationsOmonos _declarationsOnamesInScope _declarationsOorderedTypeSynonyms _declarationsOparentTree _declarationsOpatternMatchWarnings _declarationsOsubstitution _declarationsOtypeSignatures _declarationsOtypeschemeMap _declarationsOuniqueChunk) + _declarationsObindingGroups = rule2537 () + _lhsOassumptions :: Assumptions + _lhsOconstraints :: ConstraintSet + _lhsObetaUnique :: Int + (_lhsOassumptions,_lhsOconstraints,_inheritedBDG,_chunkNr,_lhsObetaUnique,_implicitsFM) = rule2538 _declarationsIbetaUnique _declarationsIbindingGroups _declarationsItypeSignatures _declarationsIuniqueChunk _lhsIassumptions _lhsIconstraints _lhsIcurrentChunk _lhsImonos + _inferredTypes = rule2539 _implicitsFM _lhsItypeschemeMap + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2540 _declarationsIcollectWarnings _declarationsIsimplePatNames _inferredTypes + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2541 _declarationsIcollectErrors _declarationsIrestrictedNames _inferredTypes + _lhsOlocalTypes :: M.Map NameWithRange TpScheme + _lhsOlocalTypes = rule2542 _declarationsIbindingGroups _declarationsItypeSignatures _inferredTypes + _declarationsOtypeSignatures = rule2543 () + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2544 _chunkNr + _declInfo = rule2545 _declarationsIself _lhsImonos + _theNode = rule2546 _declInfo _declarationsIinfoTrees _lhsIparentTree + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2547 _theNode + _declarationsOparentTree = rule2548 _theNode + (_collectTypeConstructors,_collectValueConstructors,_collectTypeSynonyms,_collectConstructorEnv,_derivedFunctions,_operatorFixities) = rule2549 () + (_namesInScope,_unboundNames,_scopeInfo) = rule2550 _declarationsIdeclVarNames _declarationsIunboundNames _lhsInamesInScope _lhsIunboundNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2551 _unboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2552 _declarationsIcollectInstances + _self = rule2553 _declarationsIself + _lhsOself :: MaybeDeclarations + _lhsOself = rule2554 _self + _lhsOcounter :: Int + _lhsOcounter = rule2555 _declarationsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2556 _declarationsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2557 _declarationsImatchIO + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2558 _namesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2559 _declarationsIpatternMatchWarnings + _declarationsOallPatterns = rule2560 _lhsIallPatterns + _declarationsOallTypeSchemes = rule2561 _lhsIallTypeSchemes + _declarationsOavailablePredicates = rule2562 _lhsIavailablePredicates + _declarationsObetaUnique = rule2563 _lhsIbetaUnique + _declarationsOclassEnvironment = rule2564 _lhsIclassEnvironment + _declarationsOcollectErrors = rule2565 _lhsIcollectErrors + _declarationsOcollectWarnings = rule2566 _lhsIcollectWarnings + _declarationsOcounter = rule2567 _lhsIcounter + _declarationsOcurrentChunk = rule2568 _lhsIcurrentChunk + _declarationsOdictionaryEnvironment = rule2569 _lhsIdictionaryEnvironment + _declarationsOimportEnvironment = rule2570 _lhsIimportEnvironment + _declarationsOinheritedBDG = rule2571 _inheritedBDG + _declarationsOmatchIO = rule2572 _lhsImatchIO + _declarationsOmonos = rule2573 _lhsImonos + _declarationsOnamesInScope = rule2574 _namesInScope + _declarationsOorderedTypeSynonyms = rule2575 _lhsIorderedTypeSynonyms + _declarationsOpatternMatchWarnings = rule2576 _lhsIpatternMatchWarnings + _declarationsOsubstitution = rule2577 _lhsIsubstitution + _declarationsOtypeschemeMap = rule2578 _lhsItypeschemeMap + _declarationsOuniqueChunk = rule2579 _lhsIuniqueChunk + __result_ = T_MaybeDeclarations_vOut88 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOlocalTypes _lhsOmatchIO _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule2537 #-} + rule2537 = \ (_ :: ()) -> + [] + {-# INLINE rule2538 #-} + rule2538 = \ ((_declarationsIbetaUnique) :: Int) ((_declarationsIbindingGroups) :: BindingGroups) ((_declarationsItypeSignatures) :: TypeEnvironment) ((_declarationsIuniqueChunk) :: Int) ((_lhsIassumptions) :: Assumptions) ((_lhsIconstraints) :: ConstraintSet) ((_lhsIcurrentChunk) :: Int) ((_lhsImonos) :: Monos) -> + let inputBDG = (False, _lhsIcurrentChunk, _declarationsIuniqueChunk, _lhsImonos, _declarationsItypeSignatures, mybdggroup, _declarationsIbetaUnique) + mybdggroup = Just (_lhsIassumptions, [_lhsIconstraints]) + in performBindingGroup inputBDG _declarationsIbindingGroups + {-# INLINE rule2539 #-} + rule2539 = \ _implicitsFM ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + findInferredTypes _lhsItypeschemeMap _implicitsFM + {-# INLINE rule2540 #-} + rule2540 = \ ((_declarationsIcollectWarnings) :: Warnings) ((_declarationsIsimplePatNames) :: Names) _inferredTypes -> + missingTypeSignature False _declarationsIsimplePatNames _inferredTypes + ++ _declarationsIcollectWarnings + {-# INLINE rule2541 #-} + rule2541 = \ ((_declarationsIcollectErrors) :: TypeErrors) ((_declarationsIrestrictedNames) :: Names) _inferredTypes -> + restrictedNameErrors _inferredTypes _declarationsIrestrictedNames + ++ _declarationsIcollectErrors + {-# INLINE rule2542 #-} + rule2542 = \ ((_declarationsIbindingGroups) :: BindingGroups) ((_declarationsItypeSignatures) :: TypeEnvironment) _inferredTypes -> + makeLocalTypeEnv (_declarationsItypeSignatures `M.union` _inferredTypes) _declarationsIbindingGroups + {-# INLINE rule2543 #-} + rule2543 = \ (_ :: ()) -> + M.empty + {-# INLINE rule2544 #-} + rule2544 = \ _chunkNr -> + _chunkNr + {-# INLINE rule2545 #-} + rule2545 = \ ((_declarationsIself) :: Declarations) ((_lhsImonos) :: Monos) -> + LocalInfo { self = UHA_Decls _declarationsIself + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule2546 #-} + rule2546 = \ _declInfo ((_declarationsIinfoTrees) :: InfoTrees) ((_lhsIparentTree) :: InfoTree) -> + node _lhsIparentTree _declInfo _declarationsIinfoTrees + {-# INLINE rule2547 #-} + rule2547 = \ _theNode -> + [_theNode] + {-# INLINE rule2548 #-} + rule2548 = \ _theNode -> + _theNode + {-# INLINE rule2549 #-} + rule2549 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "toplevel MaybeDeclaration" + {-# INLINE rule2550 #-} + rule2550 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsIunboundNames) :: Names) -> + changeOfScope _declarationsIdeclVarNames (_declarationsIunboundNames ++ _lhsIunboundNames) _lhsInamesInScope + {-# INLINE rule2551 #-} + rule2551 = \ _unboundNames -> + _unboundNames + {-# INLINE rule2552 #-} + rule2552 = \ ((_declarationsIcollectInstances) :: [(Name, Instance)]) -> + _declarationsIcollectInstances + {-# INLINE rule2553 #-} + rule2553 = \ ((_declarationsIself) :: Declarations) -> + MaybeDeclarations_Just _declarationsIself + {-# INLINE rule2554 #-} + rule2554 = \ _self -> + _self + {-# INLINE rule2555 #-} + rule2555 = \ ((_declarationsIcounter) :: Int) -> + _declarationsIcounter + {-# INLINE rule2556 #-} + rule2556 = \ ((_declarationsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _declarationsIdictionaryEnvironment + {-# INLINE rule2557 #-} + rule2557 = \ ((_declarationsImatchIO) :: IO ()) -> + _declarationsImatchIO + {-# INLINE rule2558 #-} + rule2558 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2559 #-} + rule2559 = \ ((_declarationsIpatternMatchWarnings) :: [Warning]) -> + _declarationsIpatternMatchWarnings + {-# INLINE rule2560 #-} + rule2560 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule2561 #-} + rule2561 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule2562 #-} + rule2562 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule2563 #-} + rule2563 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2564 #-} + rule2564 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2565 #-} + rule2565 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2566 #-} + rule2566 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2567 #-} + rule2567 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2568 #-} + rule2568 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule2569 #-} + rule2569 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2570 #-} + rule2570 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2571 #-} + rule2571 = \ _inheritedBDG -> + _inheritedBDG + {-# INLINE rule2572 #-} + rule2572 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2573 #-} + rule2573 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2574 #-} + rule2574 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2575 #-} + rule2575 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2576 #-} + rule2576 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2577 #-} + rule2577 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule2578 #-} + rule2578 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule2579 #-} + rule2579 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + +-- MaybeExports ------------------------------------------------ +-- wrapper +data Inh_MaybeExports = Inh_MaybeExports { } +data Syn_MaybeExports = Syn_MaybeExports { self_Syn_MaybeExports :: (MaybeExports) } +{-# INLINABLE wrap_MaybeExports #-} +wrap_MaybeExports :: T_MaybeExports -> Inh_MaybeExports -> (Syn_MaybeExports ) +wrap_MaybeExports (T_MaybeExports act) (Inh_MaybeExports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExports_vIn91 + (T_MaybeExports_vOut91 _lhsOself) <- return (inv_MaybeExports_s92 sem arg) + return (Syn_MaybeExports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExports #-} +sem_MaybeExports :: MaybeExports -> T_MaybeExports +sem_MaybeExports ( MaybeExports_Nothing ) = sem_MaybeExports_Nothing +sem_MaybeExports ( MaybeExports_Just exports_ ) = sem_MaybeExports_Just ( sem_Exports exports_ ) + +-- semantic domain +newtype T_MaybeExports = T_MaybeExports { + attach_T_MaybeExports :: Identity (T_MaybeExports_s92 ) + } +newtype T_MaybeExports_s92 = C_MaybeExports_s92 { + inv_MaybeExports_s92 :: (T_MaybeExports_v91 ) + } +data T_MaybeExports_s93 = C_MaybeExports_s93 +type T_MaybeExports_v91 = (T_MaybeExports_vIn91 ) -> (T_MaybeExports_vOut91 ) +data T_MaybeExports_vIn91 = T_MaybeExports_vIn91 +data T_MaybeExports_vOut91 = T_MaybeExports_vOut91 (MaybeExports) +{-# NOINLINE sem_MaybeExports_Nothing #-} +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _self = rule2580 () + _lhsOself :: MaybeExports + _lhsOself = rule2581 _self + __result_ = T_MaybeExports_vOut91 _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule2580 #-} + rule2580 = \ (_ :: ()) -> + MaybeExports_Nothing + {-# INLINE rule2581 #-} + rule2581 = \ _self -> + _self +{-# NOINLINE sem_MaybeExports_Just #-} +sem_MaybeExports_Just :: T_Exports -> T_MaybeExports +sem_MaybeExports_Just arg_exports_ = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _exportsX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_exports_)) + (T_Exports_vOut37 _exportsIself) = inv_Exports_s38 _exportsX38 (T_Exports_vIn37 ) + _self = rule2582 _exportsIself + _lhsOself :: MaybeExports + _lhsOself = rule2583 _self + __result_ = T_MaybeExports_vOut91 _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule2582 #-} + rule2582 = \ ((_exportsIself) :: Exports) -> + MaybeExports_Just _exportsIself + {-# INLINE rule2583 #-} + rule2583 = \ _self -> + _self + +-- MaybeExpression --------------------------------------------- +-- wrapper +data Inh_MaybeExpression = Inh_MaybeExpression { allPatterns_Inh_MaybeExpression :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_MaybeExpression :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_MaybeExpression :: (Predicates), betaUnique_Inh_MaybeExpression :: (Int), classEnvironment_Inh_MaybeExpression :: (ClassEnvironment), collectErrors_Inh_MaybeExpression :: (TypeErrors), collectWarnings_Inh_MaybeExpression :: (Warnings), counter_Inh_MaybeExpression :: (Int), currentChunk_Inh_MaybeExpression :: (Int), dictionaryEnvironment_Inh_MaybeExpression :: (DictionaryEnvironment), importEnvironment_Inh_MaybeExpression :: (ImportEnvironment), matchIO_Inh_MaybeExpression :: (IO ()), monos_Inh_MaybeExpression :: (Monos), namesInScope_Inh_MaybeExpression :: (Names), orderedTypeSynonyms_Inh_MaybeExpression :: (OrderedTypeSynonyms), parentTree_Inh_MaybeExpression :: (InfoTree), patternMatchWarnings_Inh_MaybeExpression :: ([Warning]), substitution_Inh_MaybeExpression :: (FixpointSubstitution), tryPatterns_Inh_MaybeExpression :: ([(MaybeExpression, [String])]), typeschemeMap_Inh_MaybeExpression :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_MaybeExpression :: (Int), uniqueSecondRound_Inh_MaybeExpression :: (Int) } +data Syn_MaybeExpression = Syn_MaybeExpression { assumptions_Syn_MaybeExpression :: (Assumptions), beta_Syn_MaybeExpression :: (Tp), betaUnique_Syn_MaybeExpression :: (Int), collectErrors_Syn_MaybeExpression :: (TypeErrors), collectInstances_Syn_MaybeExpression :: ([(Name, Instance)]), collectWarnings_Syn_MaybeExpression :: (Warnings), constraints_Syn_MaybeExpression :: (ConstraintSet), counter_Syn_MaybeExpression :: (Int), dictionaryEnvironment_Syn_MaybeExpression :: (DictionaryEnvironment), infoTrees_Syn_MaybeExpression :: (InfoTrees), matchIO_Syn_MaybeExpression :: (IO ()), matches_Syn_MaybeExpression :: ([Maybe MetaVariableTable]), patternMatchWarnings_Syn_MaybeExpression :: ([Warning]), section_Syn_MaybeExpression :: (Bool), self_Syn_MaybeExpression :: (MaybeExpression), unboundNames_Syn_MaybeExpression :: (Names), uniqueChunk_Syn_MaybeExpression :: (Int), uniqueSecondRound_Syn_MaybeExpression :: (Int) } +{-# INLINABLE wrap_MaybeExpression #-} +wrap_MaybeExpression :: T_MaybeExpression -> Inh_MaybeExpression -> (Syn_MaybeExpression ) +wrap_MaybeExpression (T_MaybeExpression act) (Inh_MaybeExpression _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExpression_vIn94 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound + (T_MaybeExpression_vOut94 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOsection _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) <- return (inv_MaybeExpression_s95 sem arg) + return (Syn_MaybeExpression _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOsection _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) + ) + +-- cata +{-# NOINLINE sem_MaybeExpression #-} +sem_MaybeExpression :: MaybeExpression -> T_MaybeExpression +sem_MaybeExpression ( MaybeExpression_Nothing ) = sem_MaybeExpression_Nothing +sem_MaybeExpression ( MaybeExpression_Just expression_ ) = sem_MaybeExpression_Just ( sem_Expression expression_ ) + +-- semantic domain +newtype T_MaybeExpression = T_MaybeExpression { + attach_T_MaybeExpression :: Identity (T_MaybeExpression_s95 ) + } +newtype T_MaybeExpression_s95 = C_MaybeExpression_s95 { + inv_MaybeExpression_s95 :: (T_MaybeExpression_v94 ) + } +data T_MaybeExpression_s96 = C_MaybeExpression_s96 +type T_MaybeExpression_v94 = (T_MaybeExpression_vIn94 ) -> (T_MaybeExpression_vOut94 ) +data T_MaybeExpression_vIn94 = T_MaybeExpression_vIn94 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) ([(MaybeExpression, [String])]) (M.Map Int (Scheme Predicates)) (Int) (Int) +data T_MaybeExpression_vOut94 = T_MaybeExpression_vOut94 (Assumptions) (Tp) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (DictionaryEnvironment) (InfoTrees) (IO ()) ([Maybe MetaVariableTable]) ([Warning]) (Bool) (MaybeExpression) (Names) (Int) (Int) +{-# NOINLINE sem_MaybeExpression_Nothing #-} +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _lhsOsection :: Bool + _lhsOsection = rule2584 () + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2585 _lhsIbetaUnique + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2586 () + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2587 () + _beta = rule2588 _lhsIbetaUnique + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2589 () + _lhsOmatches :: [Maybe MetaVariableTable] + ((),_lhsOmatches,_,_,_,_) = rule2590 _lhsItryPatterns + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2591 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2592 () + _self = rule2593 () + _lhsOself :: MaybeExpression + _lhsOself = rule2594 _self + _lhsObeta :: Tp + _lhsObeta = rule2595 _beta + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2596 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2597 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule2598 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2599 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2600 _lhsImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2601 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2602 _lhsIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule2603 _lhsIuniqueSecondRound + __result_ = T_MaybeExpression_vOut94 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOsection _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule2584 #-} + rule2584 = \ (_ :: ()) -> + True + {-# INLINE rule2585 #-} + rule2585 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule2586 #-} + rule2586 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule2587 #-} + rule2587 = \ (_ :: ()) -> + emptyTree + {-# INLINE rule2588 #-} + rule2588 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule2589 #-} + rule2589 = \ (_ :: ()) -> + [] + {-# INLINE rule2590 #-} + rule2590 = \ ((_lhsItryPatterns) :: [(MaybeExpression, [String])]) -> + match0' match_MaybeExpression_Nothing _lhsItryPatterns [] [] + {-# INLINE rule2591 #-} + rule2591 = \ (_ :: ()) -> + [] + {-# INLINE rule2592 #-} + rule2592 = \ (_ :: ()) -> + [] + {-# INLINE rule2593 #-} + rule2593 = \ (_ :: ()) -> + MaybeExpression_Nothing + {-# INLINE rule2594 #-} + rule2594 = \ _self -> + _self + {-# INLINE rule2595 #-} + rule2595 = \ _beta -> + _beta + {-# INLINE rule2596 #-} + rule2596 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2597 #-} + rule2597 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2598 #-} + rule2598 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2599 #-} + rule2599 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2600 #-} + rule2600 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2601 #-} + rule2601 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2602 #-} + rule2602 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule2603 #-} + rule2603 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_MaybeExpression_Just #-} +sem_MaybeExpression_Just :: T_Expression -> T_MaybeExpression +sem_MaybeExpression_Just arg_expression_ = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItryPatterns _lhsItypeschemeMap _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _lhsOsection :: Bool + _lhsOsection = rule2604 () + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule2605 _expressionIinfoTree + _lhsOmatches :: [Maybe MetaVariableTable] + (_expressionOtryPatterns,_lhsOmatches,_,_,_,_) = rule2606 _expressionImatches _lhsItryPatterns + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2607 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2608 _expressionIunboundNames + _self = rule2609 _expressionIself + _lhsOself :: MaybeExpression + _lhsOself = rule2610 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2611 _expressionIassumptions + _lhsObeta :: Tp + _lhsObeta = rule2612 _expressionIbeta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2613 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule2614 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule2615 _expressionIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2616 _expressionIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule2617 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2618 _expressionIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule2619 _expressionImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2620 _expressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule2621 _expressionIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule2622 _expressionIuniqueSecondRound + _expressionOallPatterns = rule2623 _lhsIallPatterns + _expressionOallTypeSchemes = rule2624 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule2625 _lhsIavailablePredicates + _expressionObetaUnique = rule2626 _lhsIbetaUnique + _expressionOclassEnvironment = rule2627 _lhsIclassEnvironment + _expressionOcollectErrors = rule2628 _lhsIcollectErrors + _expressionOcollectWarnings = rule2629 _lhsIcollectWarnings + _expressionOcounter = rule2630 _lhsIcounter + _expressionOcurrentChunk = rule2631 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule2632 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule2633 _lhsIimportEnvironment + _expressionOmatchIO = rule2634 _lhsImatchIO + _expressionOmonos = rule2635 _lhsImonos + _expressionOnamesInScope = rule2636 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule2637 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule2638 _lhsIparentTree + _expressionOpatternMatchWarnings = rule2639 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule2640 _lhsIsubstitution + _expressionOtypeschemeMap = rule2641 _lhsItypeschemeMap + _expressionOuniqueChunk = rule2642 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule2643 _lhsIuniqueSecondRound + __result_ = T_MaybeExpression_vOut94 _lhsOassumptions _lhsObeta _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmatches _lhsOpatternMatchWarnings _lhsOsection _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule2604 #-} + rule2604 = \ (_ :: ()) -> + False + {-# INLINE rule2605 #-} + rule2605 = \ ((_expressionIinfoTree) :: InfoTree) -> + [_expressionIinfoTree] + {-# INLINE rule2606 #-} + rule2606 = \ ((_expressionImatches) :: [Maybe MetaVariableTable]) ((_lhsItryPatterns) :: [(MaybeExpression, [String])]) -> + match1' match_MaybeExpression_Just _lhsItryPatterns [] [_expressionImatches] + {-# INLINE rule2607 #-} + rule2607 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule2608 #-} + rule2608 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule2609 #-} + rule2609 = \ ((_expressionIself) :: Expression) -> + MaybeExpression_Just _expressionIself + {-# INLINE rule2610 #-} + rule2610 = \ _self -> + _self + {-# INLINE rule2611 #-} + rule2611 = \ ((_expressionIassumptions) :: Assumptions) -> + _expressionIassumptions + {-# INLINE rule2612 #-} + rule2612 = \ ((_expressionIbeta) :: Tp) -> + _expressionIbeta + {-# INLINE rule2613 #-} + rule2613 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule2614 #-} + rule2614 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule2615 #-} + rule2615 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule2616 #-} + rule2616 = \ ((_expressionIconstraints) :: ConstraintSet) -> + _expressionIconstraints + {-# INLINE rule2617 #-} + rule2617 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule2618 #-} + rule2618 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule2619 #-} + rule2619 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule2620 #-} + rule2620 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule2621 #-} + rule2621 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule2622 #-} + rule2622 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule2623 #-} + rule2623 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule2624 #-} + rule2624 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule2625 #-} + rule2625 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule2626 #-} + rule2626 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2627 #-} + rule2627 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2628 #-} + rule2628 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule2629 #-} + rule2629 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule2630 #-} + rule2630 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2631 #-} + rule2631 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule2632 #-} + rule2632 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule2633 #-} + rule2633 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2634 #-} + rule2634 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule2635 #-} + rule2635 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2636 #-} + rule2636 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2637 #-} + rule2637 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2638 #-} + rule2638 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2639 #-} + rule2639 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2640 #-} + rule2640 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule2641 #-} + rule2641 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule2642 #-} + rule2642 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule2643 #-} + rule2643 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + +-- MaybeImportSpecification ------------------------------------ +-- wrapper +data Inh_MaybeImportSpecification = Inh_MaybeImportSpecification { } +data Syn_MaybeImportSpecification = Syn_MaybeImportSpecification { self_Syn_MaybeImportSpecification :: (MaybeImportSpecification) } +{-# INLINABLE wrap_MaybeImportSpecification #-} +wrap_MaybeImportSpecification :: T_MaybeImportSpecification -> Inh_MaybeImportSpecification -> (Syn_MaybeImportSpecification ) +wrap_MaybeImportSpecification (T_MaybeImportSpecification act) (Inh_MaybeImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeImportSpecification_vIn97 + (T_MaybeImportSpecification_vOut97 _lhsOself) <- return (inv_MaybeImportSpecification_s98 sem arg) + return (Syn_MaybeImportSpecification _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeImportSpecification #-} +sem_MaybeImportSpecification :: MaybeImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification ( MaybeImportSpecification_Nothing ) = sem_MaybeImportSpecification_Nothing +sem_MaybeImportSpecification ( MaybeImportSpecification_Just importspecification_ ) = sem_MaybeImportSpecification_Just ( sem_ImportSpecification importspecification_ ) + +-- semantic domain +newtype T_MaybeImportSpecification = T_MaybeImportSpecification { + attach_T_MaybeImportSpecification :: Identity (T_MaybeImportSpecification_s98 ) + } +newtype T_MaybeImportSpecification_s98 = C_MaybeImportSpecification_s98 { + inv_MaybeImportSpecification_s98 :: (T_MaybeImportSpecification_v97 ) + } +data T_MaybeImportSpecification_s99 = C_MaybeImportSpecification_s99 +type T_MaybeImportSpecification_v97 = (T_MaybeImportSpecification_vIn97 ) -> (T_MaybeImportSpecification_vOut97 ) +data T_MaybeImportSpecification_vIn97 = T_MaybeImportSpecification_vIn97 +data T_MaybeImportSpecification_vOut97 = T_MaybeImportSpecification_vOut97 (MaybeImportSpecification) +{-# NOINLINE sem_MaybeImportSpecification_Nothing #-} +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _self = rule2644 () + _lhsOself :: MaybeImportSpecification + _lhsOself = rule2645 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule2644 #-} + rule2644 = \ (_ :: ()) -> + MaybeImportSpecification_Nothing + {-# INLINE rule2645 #-} + rule2645 = \ _self -> + _self +{-# NOINLINE sem_MaybeImportSpecification_Just #-} +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification_Just arg_importspecification_ = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _importspecificationX77 = Control.Monad.Identity.runIdentity (attach_T_ImportSpecification (arg_importspecification_)) + (T_ImportSpecification_vOut76 _importspecificationIself) = inv_ImportSpecification_s77 _importspecificationX77 (T_ImportSpecification_vIn76 ) + _self = rule2646 _importspecificationIself + _lhsOself :: MaybeImportSpecification + _lhsOself = rule2647 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule2646 #-} + rule2646 = \ ((_importspecificationIself) :: ImportSpecification) -> + MaybeImportSpecification_Just _importspecificationIself + {-# INLINE rule2647 #-} + rule2647 = \ _self -> + _self + +-- MaybeInt ---------------------------------------------------- +-- wrapper +data Inh_MaybeInt = Inh_MaybeInt { } +data Syn_MaybeInt = Syn_MaybeInt { self_Syn_MaybeInt :: (MaybeInt) } +{-# INLINABLE wrap_MaybeInt #-} +wrap_MaybeInt :: T_MaybeInt -> Inh_MaybeInt -> (Syn_MaybeInt ) +wrap_MaybeInt (T_MaybeInt act) (Inh_MaybeInt ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeInt_vIn100 + (T_MaybeInt_vOut100 _lhsOself) <- return (inv_MaybeInt_s101 sem arg) + return (Syn_MaybeInt _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeInt #-} +sem_MaybeInt :: MaybeInt -> T_MaybeInt +sem_MaybeInt ( MaybeInt_Nothing ) = sem_MaybeInt_Nothing +sem_MaybeInt ( MaybeInt_Just int_ ) = sem_MaybeInt_Just int_ + +-- semantic domain +newtype T_MaybeInt = T_MaybeInt { + attach_T_MaybeInt :: Identity (T_MaybeInt_s101 ) + } +newtype T_MaybeInt_s101 = C_MaybeInt_s101 { + inv_MaybeInt_s101 :: (T_MaybeInt_v100 ) + } +data T_MaybeInt_s102 = C_MaybeInt_s102 +type T_MaybeInt_v100 = (T_MaybeInt_vIn100 ) -> (T_MaybeInt_vOut100 ) +data T_MaybeInt_vIn100 = T_MaybeInt_vIn100 +data T_MaybeInt_vOut100 = T_MaybeInt_vOut100 (MaybeInt) +{-# NOINLINE sem_MaybeInt_Nothing #-} +sem_MaybeInt_Nothing :: T_MaybeInt +sem_MaybeInt_Nothing = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule2648 () + _lhsOself :: MaybeInt + _lhsOself = rule2649 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule2648 #-} + rule2648 = \ (_ :: ()) -> + MaybeInt_Nothing + {-# INLINE rule2649 #-} + rule2649 = \ _self -> + _self +{-# NOINLINE sem_MaybeInt_Just #-} +sem_MaybeInt_Just :: (Int) -> T_MaybeInt +sem_MaybeInt_Just arg_int_ = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule2650 arg_int_ + _lhsOself :: MaybeInt + _lhsOself = rule2651 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule2650 #-} + rule2650 = \ int_ -> + MaybeInt_Just int_ + {-# INLINE rule2651 #-} + rule2651 = \ _self -> + _self + +-- MaybeName --------------------------------------------------- +-- wrapper +data Inh_MaybeName = Inh_MaybeName { } +data Syn_MaybeName = Syn_MaybeName { self_Syn_MaybeName :: (MaybeName) } +{-# INLINABLE wrap_MaybeName #-} +wrap_MaybeName :: T_MaybeName -> Inh_MaybeName -> (Syn_MaybeName ) +wrap_MaybeName (T_MaybeName act) (Inh_MaybeName ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeName_vIn103 + (T_MaybeName_vOut103 _lhsOself) <- return (inv_MaybeName_s104 sem arg) + return (Syn_MaybeName _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeName #-} +sem_MaybeName :: MaybeName -> T_MaybeName +sem_MaybeName ( MaybeName_Nothing ) = sem_MaybeName_Nothing +sem_MaybeName ( MaybeName_Just name_ ) = sem_MaybeName_Just ( sem_Name name_ ) + +-- semantic domain +newtype T_MaybeName = T_MaybeName { + attach_T_MaybeName :: Identity (T_MaybeName_s104 ) + } +newtype T_MaybeName_s104 = C_MaybeName_s104 { + inv_MaybeName_s104 :: (T_MaybeName_v103 ) + } +data T_MaybeName_s105 = C_MaybeName_s105 +type T_MaybeName_v103 = (T_MaybeName_vIn103 ) -> (T_MaybeName_vOut103 ) +data T_MaybeName_vIn103 = T_MaybeName_vIn103 +data T_MaybeName_vOut103 = T_MaybeName_vOut103 (MaybeName) +{-# NOINLINE sem_MaybeName_Nothing #-} +sem_MaybeName_Nothing :: T_MaybeName +sem_MaybeName_Nothing = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _self = rule2652 () + _lhsOself :: MaybeName + _lhsOself = rule2653 _self + __result_ = T_MaybeName_vOut103 _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule2652 #-} + rule2652 = \ (_ :: ()) -> + MaybeName_Nothing + {-# INLINE rule2653 #-} + rule2653 = \ _self -> + _self +{-# NOINLINE sem_MaybeName_Just #-} +sem_MaybeName_Just :: T_Name -> T_MaybeName +sem_MaybeName_Just arg_name_ = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule2654 _nameIself + _lhsOself :: MaybeName + _lhsOself = rule2655 _self + __result_ = T_MaybeName_vOut103 _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule2654 #-} + rule2654 = \ ((_nameIself) :: Name) -> + MaybeName_Just _nameIself + {-# INLINE rule2655 #-} + rule2655 = \ _self -> + _self + +-- MaybeNames -------------------------------------------------- +-- wrapper +data Inh_MaybeNames = Inh_MaybeNames { } +data Syn_MaybeNames = Syn_MaybeNames { self_Syn_MaybeNames :: (MaybeNames) } +{-# INLINABLE wrap_MaybeNames #-} +wrap_MaybeNames :: T_MaybeNames -> Inh_MaybeNames -> (Syn_MaybeNames ) +wrap_MaybeNames (T_MaybeNames act) (Inh_MaybeNames ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeNames_vIn106 + (T_MaybeNames_vOut106 _lhsOself) <- return (inv_MaybeNames_s107 sem arg) + return (Syn_MaybeNames _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeNames #-} +sem_MaybeNames :: MaybeNames -> T_MaybeNames +sem_MaybeNames ( MaybeNames_Nothing ) = sem_MaybeNames_Nothing +sem_MaybeNames ( MaybeNames_Just names_ ) = sem_MaybeNames_Just ( sem_Names names_ ) + +-- semantic domain +newtype T_MaybeNames = T_MaybeNames { + attach_T_MaybeNames :: Identity (T_MaybeNames_s107 ) + } +newtype T_MaybeNames_s107 = C_MaybeNames_s107 { + inv_MaybeNames_s107 :: (T_MaybeNames_v106 ) + } +data T_MaybeNames_s108 = C_MaybeNames_s108 +type T_MaybeNames_v106 = (T_MaybeNames_vIn106 ) -> (T_MaybeNames_vOut106 ) +data T_MaybeNames_vIn106 = T_MaybeNames_vIn106 +data T_MaybeNames_vOut106 = T_MaybeNames_vOut106 (MaybeNames) +{-# NOINLINE sem_MaybeNames_Nothing #-} +sem_MaybeNames_Nothing :: T_MaybeNames +sem_MaybeNames_Nothing = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _self = rule2656 () + _lhsOself :: MaybeNames + _lhsOself = rule2657 _self + __result_ = T_MaybeNames_vOut106 _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule2656 #-} + rule2656 = \ (_ :: ()) -> + MaybeNames_Nothing + {-# INLINE rule2657 #-} + rule2657 = \ _self -> + _self +{-# NOINLINE sem_MaybeNames_Just #-} +sem_MaybeNames_Just :: T_Names -> T_MaybeNames +sem_MaybeNames_Just arg_names_ = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + _self = rule2658 _namesIself + _lhsOself :: MaybeNames + _lhsOself = rule2659 _self + __result_ = T_MaybeNames_vOut106 _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule2658 #-} + rule2658 = \ ((_namesIself) :: Names) -> + MaybeNames_Just _namesIself + {-# INLINE rule2659 #-} + rule2659 = \ _self -> + _self + +-- Module ------------------------------------------------------ +-- wrapper +data Inh_Module = Inh_Module { importEnvironment_Inh_Module :: (ImportEnvironment), options_Inh_Module :: ([Option]) } +data Syn_Module = Syn_Module { assumptions_Syn_Module :: (Assumptions), dictionaryEnvironment_Syn_Module :: (DictionaryEnvironment), infoTree_Syn_Module :: (InfoTree), logEntries_Syn_Module :: (LogEntries), self_Syn_Module :: (Module), solveResult_Syn_Module :: (SolveResult ConstraintInfo), toplevelTypes_Syn_Module :: (TypeEnvironment), typeErrors_Syn_Module :: (TypeErrors), warnings_Syn_Module :: (Warnings) } +{-# INLINABLE wrap_Module #-} +wrap_Module :: T_Module -> Inh_Module -> (Syn_Module ) +wrap_Module (T_Module act) (Inh_Module _lhsIimportEnvironment _lhsIoptions) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Module_vIn109 _lhsIimportEnvironment _lhsIoptions + (T_Module_vOut109 _lhsOassumptions _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOlogEntries _lhsOself _lhsOsolveResult _lhsOtoplevelTypes _lhsOtypeErrors _lhsOwarnings) <- return (inv_Module_s110 sem arg) + return (Syn_Module _lhsOassumptions _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOlogEntries _lhsOself _lhsOsolveResult _lhsOtoplevelTypes _lhsOtypeErrors _lhsOwarnings) + ) + +-- cata +{-# INLINE sem_Module #-} +sem_Module :: Module -> T_Module +sem_Module ( Module_Module range_ name_ exports_ body_ ) = sem_Module_Module ( sem_Range range_ ) ( sem_MaybeName name_ ) ( sem_MaybeExports exports_ ) ( sem_Body body_ ) + +-- semantic domain +newtype T_Module = T_Module { + attach_T_Module :: Identity (T_Module_s110 ) + } +newtype T_Module_s110 = C_Module_s110 { + inv_Module_s110 :: (T_Module_v109 ) + } +data T_Module_s111 = C_Module_s111 +type T_Module_v109 = (T_Module_vIn109 ) -> (T_Module_vOut109 ) +data T_Module_vIn109 = T_Module_vIn109 (ImportEnvironment) ([Option]) +data T_Module_vOut109 = T_Module_vOut109 (Assumptions) (DictionaryEnvironment) (InfoTree) (LogEntries) (Module) (SolveResult ConstraintInfo) (TypeEnvironment) (TypeErrors) (Warnings) +{-# NOINLINE sem_Module_Module #-} +sem_Module_Module :: T_Range -> T_MaybeName -> T_MaybeExports -> T_Body -> T_Module +sem_Module_Module arg_range_ arg_name_ arg_exports_ arg_body_ = T_Module (return st110) where + {-# NOINLINE st110 #-} + st110 = let + v109 :: T_Module_v109 + v109 = \ (T_Module_vIn109 _lhsIimportEnvironment _lhsIoptions) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_name_)) + _exportsX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeExports (arg_exports_)) + _bodyX14 = Control.Monad.Identity.runIdentity (attach_T_Body (arg_body_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeName_vOut103 _nameIself) = inv_MaybeName_s104 _nameX104 (T_MaybeName_vIn103 ) + (T_MaybeExports_vOut91 _exportsIself) = inv_MaybeExports_s92 _exportsX92 (T_MaybeExports_vIn91 ) + (T_Body_vOut13 _bodyIassumptions _bodyIbetaUnique _bodyIcollectErrors _bodyIcollectInstances _bodyIcollectWarnings _bodyIconstraints _bodyIcounter _bodyIdeclVarNames _bodyIdictionaryEnvironment _bodyIinfoTree _bodyImatchIO _bodyIpatternMatchWarnings _bodyIself _bodyItoplevelTypes _bodyIunboundNames _bodyIuniqueChunk) = inv_Body_s14 _bodyX14 (T_Body_vIn13 _bodyOallPatterns _bodyOallTypeSchemes _bodyOavailablePredicates _bodyObetaUnique _bodyOclassEnvironment _bodyOcollectErrors _bodyOcollectWarnings _bodyOcounter _bodyOcurrentChunk _bodyOdictionaryEnvironment _bodyOimportEnvironment _bodyOmatchIO _bodyOmonos _bodyOnamesInScope _bodyOorderedTypeSynonyms _bodyOpatternMatchWarnings _bodyOsubstitution _bodyOtypeschemeMap _bodyOuniqueChunk) + _lhsOwarnings :: Warnings + _lhsOwarnings = rule2660 _bodyIpatternMatchWarnings _warnings + (SolveResult _betaUniqueAtTheEnd _substitution _typeschemeMap _ _solveErrors) = rule2661 _solveResult + (_solveResult,_logEntries) = rule2662 _bodyIbetaUnique _bodyIconstraints _classEnv _lhsIimportEnvironment _lhsIoptions _orderedTypeSynonyms + _orderedTypeSynonyms = rule2663 _lhsIimportEnvironment + _classEnv = rule2664 _bodyIcollectInstances _lhsIimportEnvironment + _typeErrors = rule2665 _bodyIcollectErrors _classEnv _lhsIoptions _orderedTypeSynonyms _solveErrors _substitution + _warnings = rule2666 _bodyIcollectWarnings + _assumptions = rule2667 _bodyIassumptions _substitution + _initialScope = rule2668 _lhsIimportEnvironment + _monos = rule2669 _monomorphics + _monomorphics = rule2670 _lhsIimportEnvironment + _bodyOtypeschemeMap = rule2671 _typeschemeMap + _bodyObetaUnique = rule2672 _monomorphics + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule2673 _bodyIdictionaryEnvironment _lhsIoptions + _bodyOdictionaryEnvironment = rule2674 () + _bodyOclassEnvironment = rule2675 _classEnv + _bodyOavailablePredicates = rule2676 () + _bodyOcollectWarnings = rule2677 () + _bodyOcollectErrors = rule2678 () + _bodyOallTypeSchemes = rule2679 _lhsIimportEnvironment + _bodyOcurrentChunk = rule2680 () + _bodyOuniqueChunk = rule2681 () + (_namesInScope,_unboundNames,_scopeInfo) = rule2682 _bodyIdeclVarNames _bodyIunboundNames _initialScope + _bodyOcounter = rule2683 () + _bodyOmatchIO = rule2684 () + _bodyOallPatterns = rule2685 _lhsIimportEnvironment + _bodyOpatternMatchWarnings = rule2686 () + _self = rule2687 _bodyIself _exportsIself _nameIself _rangeIself + _lhsOself :: Module + _lhsOself = rule2688 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule2689 _assumptions + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2690 _bodyIinfoTree + _lhsOlogEntries :: LogEntries + _lhsOlogEntries = rule2691 _logEntries + _lhsOsolveResult :: SolveResult ConstraintInfo + _lhsOsolveResult = rule2692 _solveResult + _lhsOtoplevelTypes :: TypeEnvironment + _lhsOtoplevelTypes = rule2693 _bodyItoplevelTypes + _lhsOtypeErrors :: TypeErrors + _lhsOtypeErrors = rule2694 _typeErrors + _bodyOimportEnvironment = rule2695 _lhsIimportEnvironment + _bodyOmonos = rule2696 _monos + _bodyOnamesInScope = rule2697 _namesInScope + _bodyOorderedTypeSynonyms = rule2698 _orderedTypeSynonyms + _bodyOsubstitution = rule2699 _substitution + __result_ = T_Module_vOut109 _lhsOassumptions _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOlogEntries _lhsOself _lhsOsolveResult _lhsOtoplevelTypes _lhsOtypeErrors _lhsOwarnings + in __result_ ) + in C_Module_s110 v109 + {-# INLINE rule2660 #-} + rule2660 = \ ((_bodyIpatternMatchWarnings) :: [Warning]) _warnings -> + _warnings ++ _bodyIpatternMatchWarnings + {-# INLINE rule2661 #-} + rule2661 = \ _solveResult -> + _solveResult + {-# INLINE rule2662 #-} + rule2662 = \ ((_bodyIbetaUnique) :: Int) ((_bodyIconstraints) :: ConstraintSet) _classEnv ((_lhsIimportEnvironment) :: ImportEnvironment) ((_lhsIoptions) :: [Option]) _orderedTypeSynonyms -> + (selectConstraintSolver _lhsIoptions _lhsIimportEnvironment) + _classEnv + _orderedTypeSynonyms + _bodyIbetaUnique + _bodyIconstraints + {-# INLINE rule2663 #-} + rule2663 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + getOrderedTypeSynonyms _lhsIimportEnvironment + {-# INLINE rule2664 #-} + rule2664 = \ ((_bodyIcollectInstances) :: [(Name, Instance)]) ((_lhsIimportEnvironment) :: ImportEnvironment) -> + foldr (\(n, i) -> insertInstance (show n) i) + (createClassEnvironment _lhsIimportEnvironment) + _bodyIcollectInstances + {-# INLINE rule2665 #-} + rule2665 = \ ((_bodyIcollectErrors) :: TypeErrors) _classEnv ((_lhsIoptions) :: [Option]) _orderedTypeSynonyms _solveErrors _substitution -> + case makeTypeErrors _lhsIoptions _classEnv _orderedTypeSynonyms _substitution _solveErrors of + [] -> if NoOverloadingTypeCheck `elem` _lhsIoptions + then filter (\(TypeError _ ms _ _) -> not $ isInfixOf "Illegal overloaded type" $ show ms) _bodyIcollectErrors + else _bodyIcollectErrors + errs -> reverse errs + {-# INLINE rule2666 #-} + rule2666 = \ ((_bodyIcollectWarnings) :: Warnings) -> + _bodyIcollectWarnings + {-# INLINE rule2667 #-} + rule2667 = \ ((_bodyIassumptions) :: Assumptions) _substitution -> + let f xs = [ (n, _substitution |-> tp) | (n, tp) <- xs ] + in M.map f _bodyIassumptions + {-# INLINE rule2668 #-} + rule2668 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + M.keys (typeEnvironment _lhsIimportEnvironment) + {-# INLINE rule2669 #-} + rule2669 = \ _monomorphics -> + map TVar _monomorphics + {-# INLINE rule2670 #-} + rule2670 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + ftv ( (M.elems $ valueConstructors _lhsIimportEnvironment) + ++ (M.elems $ typeEnvironment _lhsIimportEnvironment) + ) + {-# INLINE rule2671 #-} + rule2671 = \ _typeschemeMap -> + M.fromList (M.assocs _typeschemeMap) + {-# INLINE rule2672 #-} + rule2672 = \ _monomorphics -> + if null _monomorphics + then 0 + else maximum _monomorphics + 1 + {-# INLINE rule2673 #-} + rule2673 = \ ((_bodyIdictionaryEnvironment) :: DictionaryEnvironment) ((_lhsIoptions) :: [Option]) -> + if Overloading `elem` _lhsIoptions + then _bodyIdictionaryEnvironment + else emptyDictionaryEnvironment + {-# INLINE rule2674 #-} + rule2674 = \ (_ :: ()) -> + emptyDictionaryEnvironment + {-# INLINE rule2675 #-} + rule2675 = \ _classEnv -> + _classEnv + {-# INLINE rule2676 #-} + rule2676 = \ (_ :: ()) -> + [] + {-# INLINE rule2677 #-} + rule2677 = \ (_ :: ()) -> + [] + {-# INLINE rule2678 #-} + rule2678 = \ (_ :: ()) -> + [] + {-# INLINE rule2679 #-} + rule2679 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + M.fromList [ (NameWithRange name, scheme) | (name, scheme) <- M.assocs (typeEnvironment _lhsIimportEnvironment) ] + {-# INLINE rule2680 #-} + rule2680 = \ (_ :: ()) -> + 0 + {-# INLINE rule2681 #-} + rule2681 = \ (_ :: ()) -> + 1 + {-# INLINE rule2682 #-} + rule2682 = \ ((_bodyIdeclVarNames) :: Names) ((_bodyIunboundNames) :: Names) _initialScope -> + changeOfScope (_initialScope ++ _bodyIdeclVarNames) _bodyIunboundNames [] + {-# INLINE rule2683 #-} + rule2683 = \ (_ :: ()) -> + 0 + {-# INLINE rule2684 #-} + rule2684 = \ (_ :: ()) -> + return () + {-# INLINE rule2685 #-} + rule2685 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + [ (matchInfo, typingStrategy) + | typingStrategy <- typingStrategies _lhsIimportEnvironment + , matchInfo <- matchInformation + _lhsIimportEnvironment + typingStrategy + ] + {-# INLINE rule2686 #-} + rule2686 = \ (_ :: ()) -> + [] + {-# INLINE rule2687 #-} + rule2687 = \ ((_bodyIself) :: Body) ((_exportsIself) :: MaybeExports) ((_nameIself) :: MaybeName) ((_rangeIself) :: Range) -> + Module_Module _rangeIself _nameIself _exportsIself _bodyIself + {-# INLINE rule2688 #-} + rule2688 = \ _self -> + _self + {-# INLINE rule2689 #-} + rule2689 = \ _assumptions -> + _assumptions + {-# INLINE rule2690 #-} + rule2690 = \ ((_bodyIinfoTree) :: InfoTree) -> + _bodyIinfoTree + {-# INLINE rule2691 #-} + rule2691 = \ _logEntries -> + _logEntries + {-# INLINE rule2692 #-} + rule2692 = \ _solveResult -> + _solveResult + {-# INLINE rule2693 #-} + rule2693 = \ ((_bodyItoplevelTypes) :: TypeEnvironment) -> + _bodyItoplevelTypes + {-# INLINE rule2694 #-} + rule2694 = \ _typeErrors -> + _typeErrors + {-# INLINE rule2695 #-} + rule2695 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2696 #-} + rule2696 = \ _monos -> + _monos + {-# INLINE rule2697 #-} + rule2697 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2698 #-} + rule2698 = \ _orderedTypeSynonyms -> + _orderedTypeSynonyms + {-# INLINE rule2699 #-} + rule2699 = \ _substitution -> + _substitution + +-- Name -------------------------------------------------------- +-- wrapper +data Inh_Name = Inh_Name { } +data Syn_Name = Syn_Name { self_Syn_Name :: (Name) } +{-# INLINABLE wrap_Name #-} +wrap_Name :: T_Name -> Inh_Name -> (Syn_Name ) +wrap_Name (T_Name act) (Inh_Name ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Name_vIn112 + (T_Name_vOut112 _lhsOself) <- return (inv_Name_s113 sem arg) + return (Syn_Name _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Name #-} +sem_Name :: Name -> T_Name +sem_Name ( Name_Identifier range_ module_ name_ ) = sem_Name_Identifier ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Operator range_ module_ name_ ) = sem_Name_Operator ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Special range_ module_ name_ ) = sem_Name_Special ( sem_Range range_ ) ( sem_Strings module_ ) name_ + +-- semantic domain +newtype T_Name = T_Name { + attach_T_Name :: Identity (T_Name_s113 ) + } +newtype T_Name_s113 = C_Name_s113 { + inv_Name_s113 :: (T_Name_v112 ) + } +data T_Name_s114 = C_Name_s114 +type T_Name_v112 = (T_Name_vIn112 ) -> (T_Name_vOut112 ) +data T_Name_vIn112 = T_Name_vIn112 +data T_Name_vOut112 = T_Name_vOut112 (Name) +{-# NOINLINE sem_Name_Identifier #-} +sem_Name_Identifier :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Identifier arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule2700 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule2701 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule2700 #-} + rule2700 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Identifier _rangeIself _moduleIself name_ + {-# INLINE rule2701 #-} + rule2701 = \ _self -> + _self +{-# NOINLINE sem_Name_Operator #-} +sem_Name_Operator :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Operator arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule2702 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule2703 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule2702 #-} + rule2702 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Operator _rangeIself _moduleIself name_ + {-# INLINE rule2703 #-} + rule2703 = \ _self -> + _self +{-# NOINLINE sem_Name_Special #-} +sem_Name_Special :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Special arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule2704 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule2705 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule2704 #-} + rule2704 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Special _rangeIself _moduleIself name_ + {-# INLINE rule2705 #-} + rule2705 = \ _self -> + _self + +-- Names ------------------------------------------------------- +-- wrapper +data Inh_Names = Inh_Names { } +data Syn_Names = Syn_Names { self_Syn_Names :: (Names) } +{-# INLINABLE wrap_Names #-} +wrap_Names :: T_Names -> Inh_Names -> (Syn_Names ) +wrap_Names (T_Names act) (Inh_Names ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Names_vIn115 + (T_Names_vOut115 _lhsOself) <- return (inv_Names_s116 sem arg) + return (Syn_Names _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Names #-} +sem_Names :: Names -> T_Names +sem_Names list = Prelude.foldr sem_Names_Cons sem_Names_Nil (Prelude.map sem_Name list) + +-- semantic domain +newtype T_Names = T_Names { + attach_T_Names :: Identity (T_Names_s116 ) + } +newtype T_Names_s116 = C_Names_s116 { + inv_Names_s116 :: (T_Names_v115 ) + } +data T_Names_s117 = C_Names_s117 +type T_Names_v115 = (T_Names_vIn115 ) -> (T_Names_vOut115 ) +data T_Names_vIn115 = T_Names_vIn115 +data T_Names_vOut115 = T_Names_vOut115 (Names) +{-# NOINLINE sem_Names_Cons #-} +sem_Names_Cons :: T_Name -> T_Names -> T_Names +sem_Names_Cons arg_hd_ arg_tl_ = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _hdX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_hd_)) + _tlX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_tl_)) + (T_Name_vOut112 _hdIself) = inv_Name_s113 _hdX113 (T_Name_vIn112 ) + (T_Names_vOut115 _tlIself) = inv_Names_s116 _tlX116 (T_Names_vIn115 ) + _self = rule2706 _hdIself _tlIself + _lhsOself :: Names + _lhsOself = rule2707 _self + __result_ = T_Names_vOut115 _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule2706 #-} + rule2706 = \ ((_hdIself) :: Name) ((_tlIself) :: Names) -> + (:) _hdIself _tlIself + {-# INLINE rule2707 #-} + rule2707 = \ _self -> + _self +{-# NOINLINE sem_Names_Nil #-} +sem_Names_Nil :: T_Names +sem_Names_Nil = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _self = rule2708 () + _lhsOself :: Names + _lhsOself = rule2709 _self + __result_ = T_Names_vOut115 _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule2708 #-} + rule2708 = \ (_ :: ()) -> + [] + {-# INLINE rule2709 #-} + rule2709 = \ _self -> + _self + +-- Pattern ----------------------------------------------------- +-- wrapper +data Inh_Pattern = Inh_Pattern { betaUnique_Inh_Pattern :: (Int), counter_Inh_Pattern :: (Int), importEnvironment_Inh_Pattern :: (ImportEnvironment), monos_Inh_Pattern :: (Monos), namesInScope_Inh_Pattern :: (Names), parentTree_Inh_Pattern :: (InfoTree), patternMatchWarnings_Inh_Pattern :: ([Warning]) } +data Syn_Pattern = Syn_Pattern { beta_Syn_Pattern :: (Tp), betaUnique_Syn_Pattern :: (Int), constraints_Syn_Pattern :: (ConstraintSet), counter_Syn_Pattern :: (Int), elements_Syn_Pattern :: ( [PatternElement] ), environment_Syn_Pattern :: (PatternAssumptions), infoTree_Syn_Pattern :: (InfoTree), patVarNames_Syn_Pattern :: (Names), patternMatchWarnings_Syn_Pattern :: ([Warning]), self_Syn_Pattern :: (Pattern), unboundNames_Syn_Pattern :: (Names) } +{-# INLINABLE wrap_Pattern #-} +wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) +wrap_Pattern (T_Pattern act) (Inh_Pattern _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings + (T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames) <- return (inv_Pattern_s119 sem arg) + return (Syn_Pattern _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_Pattern #-} +sem_Pattern :: Pattern -> T_Pattern +sem_Pattern ( Pattern_Hole range_ id_ ) = sem_Pattern_Hole ( sem_Range range_ ) id_ +sem_Pattern ( Pattern_Literal range_ literal_ ) = sem_Pattern_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_Variable range_ name_ ) = sem_Pattern_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Pattern ( Pattern_Constructor range_ name_ patterns_ ) = sem_Pattern_Constructor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Parenthesized range_ pattern_ ) = sem_Pattern_Parenthesized ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ ) = sem_Pattern_InfixConstructor ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name constructorOperator_ ) ( sem_Pattern rightPattern_ ) +sem_Pattern ( Pattern_List range_ patterns_ ) = sem_Pattern_List ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Tuple range_ patterns_ ) = sem_Pattern_Tuple ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Record range_ name_ recordPatternBindings_ ) = sem_Pattern_Record ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordPatternBindings recordPatternBindings_ ) +sem_Pattern ( Pattern_Negate range_ literal_ ) = sem_Pattern_Negate ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_As range_ name_ pattern_ ) = sem_Pattern_As ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Wildcard range_ ) = sem_Pattern_Wildcard ( sem_Range range_ ) +sem_Pattern ( Pattern_Irrefutable range_ pattern_ ) = sem_Pattern_Irrefutable ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Successor range_ name_ literal_ ) = sem_Pattern_Successor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_NegateFloat range_ literal_ ) = sem_Pattern_NegateFloat ( sem_Range range_ ) ( sem_Literal literal_ ) + +-- semantic domain +newtype T_Pattern = T_Pattern { + attach_T_Pattern :: Identity (T_Pattern_s119 ) + } +newtype T_Pattern_s119 = C_Pattern_s119 { + inv_Pattern_s119 :: (T_Pattern_v118 ) + } +data T_Pattern_s120 = C_Pattern_s120 +type T_Pattern_v118 = (T_Pattern_vIn118 ) -> (T_Pattern_vOut118 ) +data T_Pattern_vIn118 = T_Pattern_vIn118 (Int) (Int) (ImportEnvironment) (Monos) (Names) (InfoTree) ([Warning]) +data T_Pattern_vOut118 = T_Pattern_vOut118 (Tp) (Int) (ConstraintSet) (Int) ( [PatternElement] ) (PatternAssumptions) (InfoTree) (Names) ([Warning]) (Pattern) (Names) +{-# NOINLINE sem_Pattern_Hole #-} +sem_Pattern_Hole :: T_Range -> (Integer) -> T_Pattern +sem_Pattern_Hole arg_range_ arg_id_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2710 _lhsIbetaUnique + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2711 () + _constraints = rule2712 () + _beta = rule2713 _lhsIbetaUnique + _localInfo = rule2714 _beta _lhsImonos _self + _parentTree = rule2715 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2716 _parentTree + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2717 _i + _lhsOelements :: [PatternElement] + _lhsOelements = rule2718 () + _lhsOcounter :: Int + _i :: Int + (_lhsOcounter,_i) = rule2719 _lhsIcounter + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2720 () + _self = rule2721 _rangeIself arg_id_ + _lhsOself :: Pattern + _lhsOself = rule2722 _self + _lhsObeta :: Tp + _lhsObeta = rule2723 _beta + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2724 _constraints + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2725 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2710 #-} + rule2710 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule2711 #-} + rule2711 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule2712 #-} + rule2712 = \ (_ :: ()) -> + emptyTree + {-# INLINE rule2713 #-} + rule2713 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule2714 #-} + rule2714 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Pat _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule2715 #-} + rule2715 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule2716 #-} + rule2716 = \ _parentTree -> + _parentTree + {-# INLINE rule2717 #-} + rule2717 = \ ((_i) :: Int) -> + [ Name_Special noRange [] ("hole" ++ show _i ) ] + {-# INLINE rule2718 #-} + rule2718 = \ (_ :: ()) -> + [FiniteElement hole] + {-# INLINE rule2719 #-} + rule2719 = \ ((_lhsIcounter) :: Int) -> + let __cont = _lhsIcounter in seq __cont ( case nextUnique __cont of { (__cont, i) -> (__cont,i)} ) + {-# INLINE rule2720 #-} + rule2720 = \ (_ :: ()) -> + [] + {-# INLINE rule2721 #-} + rule2721 = \ ((_rangeIself) :: Range) id_ -> + Pattern_Hole _rangeIself id_ + {-# INLINE rule2722 #-} + rule2722 = \ _self -> + _self + {-# INLINE rule2723 #-} + rule2723 = \ _beta -> + _beta + {-# INLINE rule2724 #-} + rule2724 = \ _constraints -> + _constraints + {-# INLINE rule2725 #-} + rule2725 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_Literal #-} +sem_Pattern_Literal :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Literal arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIelements _literalIliteralType _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2726 _lhsIbetaUnique + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2727 () + _constraints = rule2728 _beta _cinfo _literalIliteralType + _beta = rule2729 _lhsIbetaUnique + _cinfo = rule2730 _parentTree + _localInfo = rule2731 _beta _lhsImonos _self + _parentTree = rule2732 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2733 _parentTree + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2734 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2735 () + _self = rule2736 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2737 _self + _lhsObeta :: Tp + _lhsObeta = rule2738 _beta + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2739 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2740 _lhsIcounter + _lhsOelements :: [PatternElement] + _lhsOelements = rule2741 _literalIelements + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2742 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2726 #-} + rule2726 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule2727 #-} + rule2727 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule2728 #-} + rule2728 = \ _beta _cinfo ((_literalIliteralType) :: Tp) -> + unitTree ((_literalIliteralType .==. _beta) _cinfo) + {-# INLINE rule2729 #-} + rule2729 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule2730 #-} + rule2730 = \ _parentTree -> + resultConstraint "literal pattern" _parentTree + [ FolkloreConstraint, HasTrustFactor 10.0 ] + {-# INLINE rule2731 #-} + rule2731 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Pat _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule2732 #-} + rule2732 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule2733 #-} + rule2733 = \ _parentTree -> + _parentTree + {-# INLINE rule2734 #-} + rule2734 = \ (_ :: ()) -> + [] + {-# INLINE rule2735 #-} + rule2735 = \ (_ :: ()) -> + [] + {-# INLINE rule2736 #-} + rule2736 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Literal _rangeIself _literalIself + {-# INLINE rule2737 #-} + rule2737 = \ _self -> + _self + {-# INLINE rule2738 #-} + rule2738 = \ _beta -> + _beta + {-# INLINE rule2739 #-} + rule2739 = \ _constraints -> + _constraints + {-# INLINE rule2740 #-} + rule2740 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2741 #-} + rule2741 = \ ((_literalIelements) :: [PatternElement] ) -> + _literalIelements + {-# INLINE rule2742 #-} + rule2742 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_Variable #-} +sem_Pattern_Variable :: T_Range -> T_Name -> T_Pattern +sem_Pattern_Variable arg_range_ arg_name_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2743 _lhsIbetaUnique + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2744 _beta _nameIself + _constraints = rule2745 _lhsIbetaUnique + _beta = rule2746 _lhsIbetaUnique + _localInfo = rule2747 _beta _lhsImonos _self + _parentTree = rule2748 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2749 _parentTree + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2750 _nameIself + _lhsOelements :: [PatternElement] + _lhsOelements = rule2751 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2752 () + _self = rule2753 _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2754 _self + _lhsObeta :: Tp + _lhsObeta = rule2755 _beta + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2756 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2757 _lhsIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2758 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2743 #-} + rule2743 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule2744 #-} + rule2744 = \ _beta ((_nameIself) :: Name) -> + M.singleton _nameIself _beta + {-# INLINE rule2745 #-} + rule2745 = \ ((_lhsIbetaUnique) :: Int) -> + Receive _lhsIbetaUnique + {-# INLINE rule2746 #-} + rule2746 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule2747 #-} + rule2747 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Pat _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule2748 #-} + rule2748 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule2749 #-} + rule2749 = \ _parentTree -> + _parentTree + {-# INLINE rule2750 #-} + rule2750 = \ ((_nameIself) :: Name) -> + [ _nameIself ] + {-# INLINE rule2751 #-} + rule2751 = \ (_ :: ()) -> + [WildcardElement] + {-# INLINE rule2752 #-} + rule2752 = \ (_ :: ()) -> + [] + {-# INLINE rule2753 #-} + rule2753 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Variable _rangeIself _nameIself + {-# INLINE rule2754 #-} + rule2754 = \ _self -> + _self + {-# INLINE rule2755 #-} + rule2755 = \ _beta -> + _beta + {-# INLINE rule2756 #-} + rule2756 = \ _constraints -> + _constraints + {-# INLINE rule2757 #-} + rule2757 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2758 #-} + rule2758 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_Constructor #-} +sem_Pattern_Constructor :: T_Range -> T_Name -> T_Patterns -> T_Pattern +sem_Pattern_Constructor arg_range_ arg_name_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIbetaUnique _patternsIbetas _patternsIconstraintslist _patternsIcounter _patternsIelementss _patternsIenvironment _patternsIinfoTrees _patternsInumberOfPatterns _patternsIpatVarNames _patternsIpatternMatchWarnings _patternsIself _patternsIunboundNames) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsObetaUnique _patternsOcounter _patternsOimportEnvironment _patternsOmonos _patternsOnamesInScope _patternsOparentTree _patternsOpatternMatchWarnings) + _patternsObetaUnique = rule2759 _lhsIbetaUnique + _constraints = rule2760 _conApply _conConstructor _patternsIconstraintslist + _beta = rule2761 _lhsIbetaUnique + _betaCon = rule2762 _lhsIbetaUnique + _conApply = rule2763 _beta _betaCon _cinfoApply _cinfoEmpty _patternsIbetas _patternsInumberOfPatterns + _conConstructor = rule2764 _betaCon _cinfoConstructor _lhsIimportEnvironment _nameIself + _cinfoConstructor = rule2765 _parentTree + _cinfoApply = rule2766 _localInfo _nameIself _parentTree _patternsIinfoTrees + _cinfoEmpty = rule2767 _parentTree + _localInfo = rule2768 _beta _lhsImonos _self + _parentTree = rule2769 _lhsIparentTree _localInfo _patternsIinfoTrees + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2770 _parentTree + _lhsOelements :: [PatternElement] + _lhsOelements = rule2771 _nameIself _patternsIelementss + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2772 _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2773 _patternsIunboundNames + _self = rule2774 _nameIself _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2775 _self + _lhsObeta :: Tp + _lhsObeta = rule2776 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2777 _patternsIbetaUnique + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2778 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2779 _patternsIcounter + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2780 _patternsIenvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2781 _patternsIpatternMatchWarnings + _patternsOcounter = rule2782 _lhsIcounter + _patternsOimportEnvironment = rule2783 _lhsIimportEnvironment + _patternsOmonos = rule2784 _lhsImonos + _patternsOnamesInScope = rule2785 _lhsInamesInScope + _patternsOparentTree = rule2786 _parentTree + _patternsOpatternMatchWarnings = rule2787 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2759 #-} + rule2759 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 2 + {-# INLINE rule2760 #-} + rule2760 = \ _conApply _conConstructor ((_patternsIconstraintslist) :: ConstraintSets) -> + _conApply .>. + Node [ listTree _conConstructor + , Node _patternsIconstraintslist + ] + {-# INLINE rule2761 #-} + rule2761 = \ ((_lhsIbetaUnique) :: Int) -> + TVar (_lhsIbetaUnique) + {-# INLINE rule2762 #-} + rule2762 = \ ((_lhsIbetaUnique) :: Int) -> + TVar (_lhsIbetaUnique + 1) + {-# INLINE rule2763 #-} + rule2763 = \ _beta _betaCon _cinfoApply _cinfoEmpty ((_patternsIbetas) :: Tps) ((_patternsInumberOfPatterns) :: Int) -> + [ (_betaCon .==. foldr (.->.) _beta _patternsIbetas) + (if _patternsInumberOfPatterns == 0 then _cinfoEmpty else _cinfoApply) ] + {-# INLINE rule2764 #-} + rule2764 = \ _betaCon _cinfoConstructor ((_lhsIimportEnvironment) :: ImportEnvironment) ((_nameIself) :: Name) -> + case M.lookup _nameIself (valueConstructors _lhsIimportEnvironment) of + Nothing -> [] + Just ctp -> [ (_betaCon .::. ctp) _cinfoConstructor ] + {-# INLINE rule2765 #-} + rule2765 = \ _parentTree -> + resultConstraint "pattern constructor" _parentTree + [ FolkloreConstraint, HasTrustFactor 10.0 ] + {-# INLINE rule2766 #-} + rule2766 = \ _localInfo ((_nameIself) :: Name) _parentTree ((_patternsIinfoTrees) :: InfoTrees) -> + specialConstraint "pattern application" _parentTree + (self _localInfo, Just $ nameToUHA_Pat _nameIself) + [ ApplicationEdge False (map attribute _patternsIinfoTrees) ] + {-# INLINE rule2767 #-} + rule2767 = \ _parentTree -> + resultConstraint "pattern constructor" _parentTree + [ HasTrustFactor 10.0 ] + {-# INLINE rule2768 #-} + rule2768 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Pat _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule2769 #-} + rule2769 = \ ((_lhsIparentTree) :: InfoTree) _localInfo ((_patternsIinfoTrees) :: InfoTrees) -> + node _lhsIparentTree _localInfo _patternsIinfoTrees + {-# INLINE rule2770 #-} + rule2770 = \ _parentTree -> + _parentTree + {-# INLINE rule2771 #-} + rule2771 = \ ((_nameIself) :: Name) ((_patternsIelementss) :: [ [PatternElement] ]) -> + FiniteElement (getNameName _nameIself) : concat _patternsIelementss + {-# INLINE rule2772 #-} + rule2772 = \ ((_patternsIpatVarNames) :: Names) -> + _patternsIpatVarNames + {-# INLINE rule2773 #-} + rule2773 = \ ((_patternsIunboundNames) :: Names) -> + _patternsIunboundNames + {-# INLINE rule2774 #-} + rule2774 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Constructor _rangeIself _nameIself _patternsIself + {-# INLINE rule2775 #-} + rule2775 = \ _self -> + _self + {-# INLINE rule2776 #-} + rule2776 = \ _beta -> + _beta + {-# INLINE rule2777 #-} + rule2777 = \ ((_patternsIbetaUnique) :: Int) -> + _patternsIbetaUnique + {-# INLINE rule2778 #-} + rule2778 = \ _constraints -> + _constraints + {-# INLINE rule2779 #-} + rule2779 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule2780 #-} + rule2780 = \ ((_patternsIenvironment) :: PatternAssumptions) -> + _patternsIenvironment + {-# INLINE rule2781 #-} + rule2781 = \ ((_patternsIpatternMatchWarnings) :: [Warning]) -> + _patternsIpatternMatchWarnings + {-# INLINE rule2782 #-} + rule2782 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2783 #-} + rule2783 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2784 #-} + rule2784 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2785 #-} + rule2785 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2786 #-} + rule2786 = \ _parentTree -> + _parentTree + {-# INLINE rule2787 #-} + rule2787 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_Parenthesized #-} +sem_Pattern_Parenthesized :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Parenthesized arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIbeta _patternIbetaUnique _patternIconstraints _patternIcounter _patternIelements _patternIenvironment _patternIinfoTree _patternIpatVarNames _patternIpatternMatchWarnings _patternIself _patternIunboundNames) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternObetaUnique _patternOcounter _patternOimportEnvironment _patternOmonos _patternOnamesInScope _patternOparentTree _patternOpatternMatchWarnings) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2788 _patternIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2789 _patternIunboundNames + _self = rule2790 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2791 _self + _lhsObeta :: Tp + _lhsObeta = rule2792 _patternIbeta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2793 _patternIbetaUnique + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2794 _patternIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule2795 _patternIcounter + _lhsOelements :: [PatternElement] + _lhsOelements = rule2796 _patternIelements + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2797 _patternIenvironment + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2798 _patternIinfoTree + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2799 _patternIpatternMatchWarnings + _patternObetaUnique = rule2800 _lhsIbetaUnique + _patternOcounter = rule2801 _lhsIcounter + _patternOimportEnvironment = rule2802 _lhsIimportEnvironment + _patternOmonos = rule2803 _lhsImonos + _patternOnamesInScope = rule2804 _lhsInamesInScope + _patternOparentTree = rule2805 _lhsIparentTree + _patternOpatternMatchWarnings = rule2806 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2788 #-} + rule2788 = \ ((_patternIpatVarNames) :: Names) -> + _patternIpatVarNames + {-# INLINE rule2789 #-} + rule2789 = \ ((_patternIunboundNames) :: Names) -> + _patternIunboundNames + {-# INLINE rule2790 #-} + rule2790 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Parenthesized _rangeIself _patternIself + {-# INLINE rule2791 #-} + rule2791 = \ _self -> + _self + {-# INLINE rule2792 #-} + rule2792 = \ ((_patternIbeta) :: Tp) -> + _patternIbeta + {-# INLINE rule2793 #-} + rule2793 = \ ((_patternIbetaUnique) :: Int) -> + _patternIbetaUnique + {-# INLINE rule2794 #-} + rule2794 = \ ((_patternIconstraints) :: ConstraintSet) -> + _patternIconstraints + {-# INLINE rule2795 #-} + rule2795 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule2796 #-} + rule2796 = \ ((_patternIelements) :: [PatternElement] ) -> + _patternIelements + {-# INLINE rule2797 #-} + rule2797 = \ ((_patternIenvironment) :: PatternAssumptions) -> + _patternIenvironment + {-# INLINE rule2798 #-} + rule2798 = \ ((_patternIinfoTree) :: InfoTree) -> + _patternIinfoTree + {-# INLINE rule2799 #-} + rule2799 = \ ((_patternIpatternMatchWarnings) :: [Warning]) -> + _patternIpatternMatchWarnings + {-# INLINE rule2800 #-} + rule2800 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2801 #-} + rule2801 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2802 #-} + rule2802 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2803 #-} + rule2803 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2804 #-} + rule2804 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2805 #-} + rule2805 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2806 #-} + rule2806 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_InfixConstructor #-} +sem_Pattern_InfixConstructor :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_InfixConstructor arg_range_ arg_leftPattern_ arg_constructorOperator_ arg_rightPattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIbeta _leftPatternIbetaUnique _leftPatternIconstraints _leftPatternIcounter _leftPatternIelements _leftPatternIenvironment _leftPatternIinfoTree _leftPatternIpatVarNames _leftPatternIpatternMatchWarnings _leftPatternIself _leftPatternIunboundNames) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 _leftPatternObetaUnique _leftPatternOcounter _leftPatternOimportEnvironment _leftPatternOmonos _leftPatternOnamesInScope _leftPatternOparentTree _leftPatternOpatternMatchWarnings) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIbeta _rightPatternIbetaUnique _rightPatternIconstraints _rightPatternIcounter _rightPatternIelements _rightPatternIenvironment _rightPatternIinfoTree _rightPatternIpatVarNames _rightPatternIpatternMatchWarnings _rightPatternIself _rightPatternIunboundNames) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 _rightPatternObetaUnique _rightPatternOcounter _rightPatternOimportEnvironment _rightPatternOmonos _rightPatternOnamesInScope _rightPatternOparentTree _rightPatternOpatternMatchWarnings) + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2807 _leftPatternIenvironment _rightPatternIenvironment + _leftPatternObetaUnique = rule2808 _lhsIbetaUnique + _constraints = rule2809 _conApply _conConstructor _leftPatternIconstraints _rightPatternIconstraints + _beta = rule2810 _lhsIbetaUnique + _betaCon = rule2811 _lhsIbetaUnique + _conApply = rule2812 _beta _betaCon _cinfoApply _leftPatternIbeta _rightPatternIbeta + _conConstructor = rule2813 _betaCon _cinfoConstructor _constructorOperatorIself _lhsIimportEnvironment + _cinfoConstructor = rule2814 _constructorOperatorIself + _cinfoApply = rule2815 _constructorOperatorIself _leftPatternIinfoTree _localInfo _parentTree _rightPatternIinfoTree + _localInfo = rule2816 _beta _lhsImonos _self + _parentTree = rule2817 _leftPatternIinfoTree _lhsIparentTree _localInfo _rightPatternIinfoTree + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2818 _parentTree + _lhsOelements :: [PatternElement] + _lhsOelements = rule2819 _constructorOperatorIself _leftPatternIelements _rightPatternIelements + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2820 _leftPatternIpatVarNames _rightPatternIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2821 _leftPatternIunboundNames _rightPatternIunboundNames + _self = rule2822 _constructorOperatorIself _leftPatternIself _rangeIself _rightPatternIself + _lhsOself :: Pattern + _lhsOself = rule2823 _self + _lhsObeta :: Tp + _lhsObeta = rule2824 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2825 _rightPatternIbetaUnique + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2826 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2827 _rightPatternIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2828 _rightPatternIpatternMatchWarnings + _leftPatternOcounter = rule2829 _lhsIcounter + _leftPatternOimportEnvironment = rule2830 _lhsIimportEnvironment + _leftPatternOmonos = rule2831 _lhsImonos + _leftPatternOnamesInScope = rule2832 _lhsInamesInScope + _leftPatternOparentTree = rule2833 _parentTree + _leftPatternOpatternMatchWarnings = rule2834 _lhsIpatternMatchWarnings + _rightPatternObetaUnique = rule2835 _leftPatternIbetaUnique + _rightPatternOcounter = rule2836 _leftPatternIcounter + _rightPatternOimportEnvironment = rule2837 _lhsIimportEnvironment + _rightPatternOmonos = rule2838 _lhsImonos + _rightPatternOnamesInScope = rule2839 _lhsInamesInScope + _rightPatternOparentTree = rule2840 _parentTree + _rightPatternOpatternMatchWarnings = rule2841 _leftPatternIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2807 #-} + rule2807 = \ ((_leftPatternIenvironment) :: PatternAssumptions) ((_rightPatternIenvironment) :: PatternAssumptions) -> + _leftPatternIenvironment `M.union` _rightPatternIenvironment + {-# INLINE rule2808 #-} + rule2808 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 2 + {-# INLINE rule2809 #-} + rule2809 = \ _conApply _conConstructor ((_leftPatternIconstraints) :: ConstraintSet) ((_rightPatternIconstraints) :: ConstraintSet) -> + _conApply .>. + Node [ listTree _conConstructor + , _leftPatternIconstraints + , _rightPatternIconstraints + ] + {-# INLINE rule2810 #-} + rule2810 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule2811 #-} + rule2811 = \ ((_lhsIbetaUnique) :: Int) -> + TVar (_lhsIbetaUnique + 1) + {-# INLINE rule2812 #-} + rule2812 = \ _beta _betaCon _cinfoApply ((_leftPatternIbeta) :: Tp) ((_rightPatternIbeta) :: Tp) -> + [ (_betaCon .==. _leftPatternIbeta .->. _rightPatternIbeta .->. _beta) _cinfoApply ] + {-# INLINE rule2813 #-} + rule2813 = \ _betaCon _cinfoConstructor ((_constructorOperatorIself) :: Name) ((_lhsIimportEnvironment) :: ImportEnvironment) -> + case M.lookup _constructorOperatorIself (valueConstructors _lhsIimportEnvironment) of + Nothing -> [] + Just ctp -> [ (_betaCon .::. ctp) _cinfoConstructor ] + {-# INLINE rule2814 #-} + rule2814 = \ ((_constructorOperatorIself) :: Name) -> + variableConstraint "pattern constructor" (nameToUHA_Pat _constructorOperatorIself) + [ FolkloreConstraint, HasTrustFactor 10.0 ] + {-# INLINE rule2815 #-} + rule2815 = \ ((_constructorOperatorIself) :: Name) ((_leftPatternIinfoTree) :: InfoTree) _localInfo _parentTree ((_rightPatternIinfoTree) :: InfoTree) -> + specialConstraint "infix pattern application" _parentTree + (self _localInfo, Just $ nameToUHA_Pat _constructorOperatorIself) + [ ApplicationEdge True (map attribute [_leftPatternIinfoTree, _rightPatternIinfoTree]) ] + {-# INLINE rule2816 #-} + rule2816 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Pat _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule2817 #-} + rule2817 = \ ((_leftPatternIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo ((_rightPatternIinfoTree) :: InfoTree) -> + node _lhsIparentTree _localInfo [_leftPatternIinfoTree, _rightPatternIinfoTree] + {-# INLINE rule2818 #-} + rule2818 = \ _parentTree -> + _parentTree + {-# INLINE rule2819 #-} + rule2819 = \ ((_constructorOperatorIself) :: Name) ((_leftPatternIelements) :: [PatternElement] ) ((_rightPatternIelements) :: [PatternElement] ) -> + FiniteElement (getNameName _constructorOperatorIself) : _leftPatternIelements ++ _rightPatternIelements + {-# INLINE rule2820 #-} + rule2820 = \ ((_leftPatternIpatVarNames) :: Names) ((_rightPatternIpatVarNames) :: Names) -> + _leftPatternIpatVarNames ++ _rightPatternIpatVarNames + {-# INLINE rule2821 #-} + rule2821 = \ ((_leftPatternIunboundNames) :: Names) ((_rightPatternIunboundNames) :: Names) -> + _leftPatternIunboundNames ++ _rightPatternIunboundNames + {-# INLINE rule2822 #-} + rule2822 = \ ((_constructorOperatorIself) :: Name) ((_leftPatternIself) :: Pattern) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + Pattern_InfixConstructor _rangeIself _leftPatternIself _constructorOperatorIself _rightPatternIself + {-# INLINE rule2823 #-} + rule2823 = \ _self -> + _self + {-# INLINE rule2824 #-} + rule2824 = \ _beta -> + _beta + {-# INLINE rule2825 #-} + rule2825 = \ ((_rightPatternIbetaUnique) :: Int) -> + _rightPatternIbetaUnique + {-# INLINE rule2826 #-} + rule2826 = \ _constraints -> + _constraints + {-# INLINE rule2827 #-} + rule2827 = \ ((_rightPatternIcounter) :: Int) -> + _rightPatternIcounter + {-# INLINE rule2828 #-} + rule2828 = \ ((_rightPatternIpatternMatchWarnings) :: [Warning]) -> + _rightPatternIpatternMatchWarnings + {-# INLINE rule2829 #-} + rule2829 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2830 #-} + rule2830 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2831 #-} + rule2831 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2832 #-} + rule2832 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2833 #-} + rule2833 = \ _parentTree -> + _parentTree + {-# INLINE rule2834 #-} + rule2834 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule2835 #-} + rule2835 = \ ((_leftPatternIbetaUnique) :: Int) -> + _leftPatternIbetaUnique + {-# INLINE rule2836 #-} + rule2836 = \ ((_leftPatternIcounter) :: Int) -> + _leftPatternIcounter + {-# INLINE rule2837 #-} + rule2837 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2838 #-} + rule2838 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2839 #-} + rule2839 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2840 #-} + rule2840 = \ _parentTree -> + _parentTree + {-# INLINE rule2841 #-} + rule2841 = \ ((_leftPatternIpatternMatchWarnings) :: [Warning]) -> + _leftPatternIpatternMatchWarnings +{-# NOINLINE sem_Pattern_List #-} +sem_Pattern_List :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_List arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIbetaUnique _patternsIbetas _patternsIconstraintslist _patternsIcounter _patternsIelementss _patternsIenvironment _patternsIinfoTrees _patternsInumberOfPatterns _patternsIpatVarNames _patternsIpatternMatchWarnings _patternsIself _patternsIunboundNames) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsObetaUnique _patternsOcounter _patternsOimportEnvironment _patternsOmonos _patternsOnamesInScope _patternsOparentTree _patternsOpatternMatchWarnings) + _patternsObetaUnique = rule2842 _lhsIbetaUnique + _constraints = rule2843 _newcon _patternsIbetas _patternsIconstraintslist _zipf + _beta = rule2844 _lhsIbetaUnique + _beta' = rule2845 _lhsIbetaUnique + _newcon = rule2846 _beta _beta' _cinfoResult + _zipf = rule2847 _beta' _cinfoElem + _cinfoElem = rule2848 _beta' _localInfo _parentTree _patternsIconstraintslist + _cinfoResult = rule2849 _parentTree + _localInfo = rule2850 _beta _lhsImonos _self + _parentTree = rule2851 _lhsIparentTree _localInfo _patternsIinfoTrees + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2852 _parentTree + _lhsOelements :: [PatternElement] + _lhsOelements = rule2853 _patternsIelementss + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2854 _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2855 _patternsIunboundNames + _self = rule2856 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2857 _self + _lhsObeta :: Tp + _lhsObeta = rule2858 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2859 _patternsIbetaUnique + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2860 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2861 _patternsIcounter + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2862 _patternsIenvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2863 _patternsIpatternMatchWarnings + _patternsOcounter = rule2864 _lhsIcounter + _patternsOimportEnvironment = rule2865 _lhsIimportEnvironment + _patternsOmonos = rule2866 _lhsImonos + _patternsOnamesInScope = rule2867 _lhsInamesInScope + _patternsOparentTree = rule2868 _parentTree + _patternsOpatternMatchWarnings = rule2869 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2842 #-} + rule2842 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 2 + {-# INLINE rule2843 #-} + rule2843 = \ _newcon ((_patternsIbetas) :: Tps) ((_patternsIconstraintslist) :: ConstraintSets) _zipf -> + _newcon .>. + Node (zipWith3 _zipf _patternsIbetas [0..] _patternsIconstraintslist) + {-# INLINE rule2844 #-} + rule2844 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule2845 #-} + rule2845 = \ ((_lhsIbetaUnique) :: Int) -> + TVar (_lhsIbetaUnique + 1) + {-# INLINE rule2846 #-} + rule2846 = \ _beta _beta' _cinfoResult -> + [ (listType _beta' .==. _beta) _cinfoResult ] + {-# INLINE rule2847 #-} + rule2847 = \ _beta' _cinfoElem -> + \tp elemNr ctree -> [ (tp .==. _beta') (_cinfoElem elemNr) ] .<. ctree + {-# INLINE rule2848 #-} + rule2848 = \ _beta' _localInfo _parentTree ((_patternsIconstraintslist) :: ConstraintSets) -> + \elemNr -> + childConstraint elemNr "element of pattern list" _parentTree $ + [ HasTrustFactor 10.0 | length _patternsIconstraintslist < 2 ] ++ + [ Unifier (head (ftv _beta')) ("pattern list", _localInfo, ordinal False (elemNr+1) ++ " element") ] + {-# INLINE rule2849 #-} + rule2849 = \ _parentTree -> + resultConstraint "pattern list" _parentTree + [ FolkloreConstraint ] + {-# INLINE rule2850 #-} + rule2850 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Pat _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule2851 #-} + rule2851 = \ ((_lhsIparentTree) :: InfoTree) _localInfo ((_patternsIinfoTrees) :: InfoTrees) -> + node _lhsIparentTree _localInfo _patternsIinfoTrees + {-# INLINE rule2852 #-} + rule2852 = \ _parentTree -> + _parentTree + {-# INLINE rule2853 #-} + rule2853 = \ ((_patternsIelementss) :: [ [PatternElement] ]) -> + listPat _patternsIelementss + {-# INLINE rule2854 #-} + rule2854 = \ ((_patternsIpatVarNames) :: Names) -> + _patternsIpatVarNames + {-# INLINE rule2855 #-} + rule2855 = \ ((_patternsIunboundNames) :: Names) -> + _patternsIunboundNames + {-# INLINE rule2856 #-} + rule2856 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_List _rangeIself _patternsIself + {-# INLINE rule2857 #-} + rule2857 = \ _self -> + _self + {-# INLINE rule2858 #-} + rule2858 = \ _beta -> + _beta + {-# INLINE rule2859 #-} + rule2859 = \ ((_patternsIbetaUnique) :: Int) -> + _patternsIbetaUnique + {-# INLINE rule2860 #-} + rule2860 = \ _constraints -> + _constraints + {-# INLINE rule2861 #-} + rule2861 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule2862 #-} + rule2862 = \ ((_patternsIenvironment) :: PatternAssumptions) -> + _patternsIenvironment + {-# INLINE rule2863 #-} + rule2863 = \ ((_patternsIpatternMatchWarnings) :: [Warning]) -> + _patternsIpatternMatchWarnings + {-# INLINE rule2864 #-} + rule2864 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2865 #-} + rule2865 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2866 #-} + rule2866 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2867 #-} + rule2867 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2868 #-} + rule2868 = \ _parentTree -> + _parentTree + {-# INLINE rule2869 #-} + rule2869 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_Tuple #-} +sem_Pattern_Tuple :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_Tuple arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIbetaUnique _patternsIbetas _patternsIconstraintslist _patternsIcounter _patternsIelementss _patternsIenvironment _patternsIinfoTrees _patternsInumberOfPatterns _patternsIpatVarNames _patternsIpatternMatchWarnings _patternsIself _patternsIunboundNames) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsObetaUnique _patternsOcounter _patternsOimportEnvironment _patternsOmonos _patternsOnamesInScope _patternsOparentTree _patternsOpatternMatchWarnings) + _patternsObetaUnique = rule2870 _lhsIbetaUnique + _constraints = rule2871 _newcon _patternsIconstraintslist + _beta = rule2872 _lhsIbetaUnique + _newcon = rule2873 _beta _cinfo _patternsIbetas + _cinfo = rule2874 _parentTree + _localInfo = rule2875 _beta _lhsImonos _self + _parentTree = rule2876 _lhsIparentTree _localInfo _patternsIinfoTrees + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2877 _parentTree + _lhsOelements :: [PatternElement] + _lhsOelements = rule2878 _patternsIelementss _patternsIself + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2879 _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2880 _patternsIunboundNames + _self = rule2881 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2882 _self + _lhsObeta :: Tp + _lhsObeta = rule2883 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2884 _patternsIbetaUnique + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2885 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2886 _patternsIcounter + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2887 _patternsIenvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2888 _patternsIpatternMatchWarnings + _patternsOcounter = rule2889 _lhsIcounter + _patternsOimportEnvironment = rule2890 _lhsIimportEnvironment + _patternsOmonos = rule2891 _lhsImonos + _patternsOnamesInScope = rule2892 _lhsInamesInScope + _patternsOparentTree = rule2893 _parentTree + _patternsOpatternMatchWarnings = rule2894 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2870 #-} + rule2870 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule2871 #-} + rule2871 = \ _newcon ((_patternsIconstraintslist) :: ConstraintSets) -> + _newcon .>. Node _patternsIconstraintslist + {-# INLINE rule2872 #-} + rule2872 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule2873 #-} + rule2873 = \ _beta _cinfo ((_patternsIbetas) :: Tps) -> + [ (tupleType _patternsIbetas .==. _beta) _cinfo ] + {-# INLINE rule2874 #-} + rule2874 = \ _parentTree -> + resultConstraint "pattern tuple" _parentTree + [ FolkloreConstraint ] + {-# INLINE rule2875 #-} + rule2875 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Pat _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule2876 #-} + rule2876 = \ ((_lhsIparentTree) :: InfoTree) _localInfo ((_patternsIinfoTrees) :: InfoTrees) -> + node _lhsIparentTree _localInfo _patternsIinfoTrees + {-# INLINE rule2877 #-} + rule2877 = \ _parentTree -> + _parentTree + {-# INLINE rule2878 #-} + rule2878 = \ ((_patternsIelementss) :: [ [PatternElement] ]) ((_patternsIself) :: Patterns) -> + FiniteElement ("(" ++ replicate (length $ tail _patternsIself) ',' ++ ")") : concat _patternsIelementss + {-# INLINE rule2879 #-} + rule2879 = \ ((_patternsIpatVarNames) :: Names) -> + _patternsIpatVarNames + {-# INLINE rule2880 #-} + rule2880 = \ ((_patternsIunboundNames) :: Names) -> + _patternsIunboundNames + {-# INLINE rule2881 #-} + rule2881 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Tuple _rangeIself _patternsIself + {-# INLINE rule2882 #-} + rule2882 = \ _self -> + _self + {-# INLINE rule2883 #-} + rule2883 = \ _beta -> + _beta + {-# INLINE rule2884 #-} + rule2884 = \ ((_patternsIbetaUnique) :: Int) -> + _patternsIbetaUnique + {-# INLINE rule2885 #-} + rule2885 = \ _constraints -> + _constraints + {-# INLINE rule2886 #-} + rule2886 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule2887 #-} + rule2887 = \ ((_patternsIenvironment) :: PatternAssumptions) -> + _patternsIenvironment + {-# INLINE rule2888 #-} + rule2888 = \ ((_patternsIpatternMatchWarnings) :: [Warning]) -> + _patternsIpatternMatchWarnings + {-# INLINE rule2889 #-} + rule2889 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2890 #-} + rule2890 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2891 #-} + rule2891 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2892 #-} + rule2892 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2893 #-} + rule2893 = \ _parentTree -> + _parentTree + {-# INLINE rule2894 #-} + rule2894 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_Record #-} +sem_Pattern_Record :: T_Range -> T_Name -> T_RecordPatternBindings -> T_Pattern +sem_Pattern_Record arg_range_ arg_name_ arg_recordPatternBindings_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordPatternBindingsX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_recordPatternBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordPatternBindings_vOut145 _recordPatternBindingsIcounter _recordPatternBindingsIpatternMatchWarnings _recordPatternBindingsIself _recordPatternBindingsIunboundNames) = inv_RecordPatternBindings_s146 _recordPatternBindingsX146 (T_RecordPatternBindings_vIn145 _recordPatternBindingsOcounter _recordPatternBindingsOnamesInScope _recordPatternBindingsOpatternMatchWarnings) + _infoTree = rule2895 () + (_beta,_constraints,_environment) = rule2896 () + _lhsOelements :: [PatternElement] + _lhsOelements = rule2897 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2898 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2899 _recordPatternBindingsIunboundNames + _self = rule2900 _nameIself _rangeIself _recordPatternBindingsIself + _lhsOself :: Pattern + _lhsOself = rule2901 _self + _lhsObeta :: Tp + _lhsObeta = rule2902 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2903 _lhsIbetaUnique + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2904 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2905 _recordPatternBindingsIcounter + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2906 _environment + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2907 _infoTree + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2908 _recordPatternBindingsIpatternMatchWarnings + _recordPatternBindingsOcounter = rule2909 _lhsIcounter + _recordPatternBindingsOnamesInScope = rule2910 _lhsInamesInScope + _recordPatternBindingsOpatternMatchWarnings = rule2911 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2895 #-} + rule2895 = \ (_ :: ()) -> + globalInfoError + {-# INLINE rule2896 #-} + rule2896 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "Pattern.Record" + {-# INLINE rule2897 #-} + rule2897 = \ (_ :: ()) -> + pmError "Pattern_Record.elements" "Records are not supported" + {-# INLINE rule2898 #-} + rule2898 = \ (_ :: ()) -> + [] + {-# INLINE rule2899 #-} + rule2899 = \ ((_recordPatternBindingsIunboundNames) :: Names) -> + _recordPatternBindingsIunboundNames + {-# INLINE rule2900 #-} + rule2900 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordPatternBindingsIself) :: RecordPatternBindings) -> + Pattern_Record _rangeIself _nameIself _recordPatternBindingsIself + {-# INLINE rule2901 #-} + rule2901 = \ _self -> + _self + {-# INLINE rule2902 #-} + rule2902 = \ _beta -> + _beta + {-# INLINE rule2903 #-} + rule2903 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2904 #-} + rule2904 = \ _constraints -> + _constraints + {-# INLINE rule2905 #-} + rule2905 = \ ((_recordPatternBindingsIcounter) :: Int) -> + _recordPatternBindingsIcounter + {-# INLINE rule2906 #-} + rule2906 = \ _environment -> + _environment + {-# INLINE rule2907 #-} + rule2907 = \ _infoTree -> + _infoTree + {-# INLINE rule2908 #-} + rule2908 = \ ((_recordPatternBindingsIpatternMatchWarnings) :: [Warning]) -> + _recordPatternBindingsIpatternMatchWarnings + {-# INLINE rule2909 #-} + rule2909 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2910 #-} + rule2910 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2911 #-} + rule2911 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_Negate #-} +sem_Pattern_Negate :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Negate arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIelements _literalIliteralType _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2912 _lhsIbetaUnique + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2913 () + _constraints = rule2914 _newcon + _beta = rule2915 _lhsIbetaUnique + _newcon = rule2916 _beta _cinfo _lhsIimportEnvironment _literalIliteralType + _cinfo = rule2917 _parentTree + _localInfo = rule2918 _beta _lhsImonos _self + _parentTree = rule2919 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2920 _parentTree + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2921 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2922 () + _self = rule2923 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2924 _self + _lhsObeta :: Tp + _lhsObeta = rule2925 _beta + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2926 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2927 _lhsIcounter + _lhsOelements :: [PatternElement] + _lhsOelements = rule2928 _literalIelements + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2929 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2912 #-} + rule2912 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule2913 #-} + rule2913 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule2914 #-} + rule2914 = \ _newcon -> + listTree _newcon + {-# INLINE rule2915 #-} + rule2915 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule2916 #-} + rule2916 = \ _beta _cinfo ((_lhsIimportEnvironment) :: ImportEnvironment) ((_literalIliteralType) :: Tp) -> + let standard = makeScheme [] [Predicate "Num" (TVar 0)] (TVar 0 .->. TVar 0) + tpscheme = M.findWithDefault standard (nameFromString "negate") (typeEnvironment _lhsIimportEnvironment) + in [ (_literalIliteralType .->. _beta .::. tpscheme) _cinfo] + {-# INLINE rule2917 #-} + rule2917 = \ _parentTree -> + resultConstraint "pattern negation" _parentTree + [ FolkloreConstraint ] + {-# INLINE rule2918 #-} + rule2918 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Pat _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule2919 #-} + rule2919 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule2920 #-} + rule2920 = \ _parentTree -> + _parentTree + {-# INLINE rule2921 #-} + rule2921 = \ (_ :: ()) -> + [] + {-# INLINE rule2922 #-} + rule2922 = \ (_ :: ()) -> + [] + {-# INLINE rule2923 #-} + rule2923 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Negate _rangeIself _literalIself + {-# INLINE rule2924 #-} + rule2924 = \ _self -> + _self + {-# INLINE rule2925 #-} + rule2925 = \ _beta -> + _beta + {-# INLINE rule2926 #-} + rule2926 = \ _constraints -> + _constraints + {-# INLINE rule2927 #-} + rule2927 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2928 #-} + rule2928 = \ ((_literalIelements) :: [PatternElement] ) -> + _literalIelements + {-# INLINE rule2929 #-} + rule2929 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_As #-} +sem_Pattern_As :: T_Range -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_As arg_range_ arg_name_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIbeta _patternIbetaUnique _patternIconstraints _patternIcounter _patternIelements _patternIenvironment _patternIinfoTree _patternIpatVarNames _patternIpatternMatchWarnings _patternIself _patternIunboundNames) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternObetaUnique _patternOcounter _patternOimportEnvironment _patternOmonos _patternOnamesInScope _patternOparentTree _patternOpatternMatchWarnings) + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2930 _beta _nameIself _patternIenvironment + _patternObetaUnique = rule2931 _lhsIbetaUnique + _constraints = rule2932 _lhsIbetaUnique _newcon _patternIconstraints + _beta = rule2933 _lhsIbetaUnique + _newcon = rule2934 _beta _cinfo _patternIbeta + _cinfo = rule2935 _localInfo _nameIself _parentTree + _localInfo = rule2936 _beta _lhsImonos _self + _parentTree = rule2937 _lhsIparentTree _localInfo _patternIinfoTree + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2938 _parentTree + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2939 _nameIself _patternIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2940 _patternIunboundNames + _self = rule2941 _nameIself _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2942 _self + _lhsObeta :: Tp + _lhsObeta = rule2943 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2944 _patternIbetaUnique + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2945 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2946 _patternIcounter + _lhsOelements :: [PatternElement] + _lhsOelements = rule2947 _patternIelements + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2948 _patternIpatternMatchWarnings + _patternOcounter = rule2949 _lhsIcounter + _patternOimportEnvironment = rule2950 _lhsIimportEnvironment + _patternOmonos = rule2951 _lhsImonos + _patternOnamesInScope = rule2952 _lhsInamesInScope + _patternOparentTree = rule2953 _parentTree + _patternOpatternMatchWarnings = rule2954 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2930 #-} + rule2930 = \ _beta ((_nameIself) :: Name) ((_patternIenvironment) :: PatternAssumptions) -> + M.insert _nameIself _beta _patternIenvironment + {-# INLINE rule2931 #-} + rule2931 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule2932 #-} + rule2932 = \ ((_lhsIbetaUnique) :: Int) _newcon ((_patternIconstraints) :: ConstraintSet) -> + _newcon .>. + Node [ Receive _lhsIbetaUnique + , _patternIconstraints + ] + {-# INLINE rule2933 #-} + rule2933 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule2934 #-} + rule2934 = \ _beta _cinfo ((_patternIbeta) :: Tp) -> + [ (_beta .==. _patternIbeta) _cinfo ] + {-# INLINE rule2935 #-} + rule2935 = \ _localInfo ((_nameIself) :: Name) _parentTree -> + specialConstraint "as pattern" _parentTree + (self _localInfo, Just $ nameToUHA_Pat _nameIself) + [] + {-# INLINE rule2936 #-} + rule2936 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Pat _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule2937 #-} + rule2937 = \ ((_lhsIparentTree) :: InfoTree) _localInfo ((_patternIinfoTree) :: InfoTree) -> + node _lhsIparentTree _localInfo [_patternIinfoTree] + {-# INLINE rule2938 #-} + rule2938 = \ _parentTree -> + _parentTree + {-# INLINE rule2939 #-} + rule2939 = \ ((_nameIself) :: Name) ((_patternIpatVarNames) :: Names) -> + _nameIself : _patternIpatVarNames + {-# INLINE rule2940 #-} + rule2940 = \ ((_patternIunboundNames) :: Names) -> + _patternIunboundNames + {-# INLINE rule2941 #-} + rule2941 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_As _rangeIself _nameIself _patternIself + {-# INLINE rule2942 #-} + rule2942 = \ _self -> + _self + {-# INLINE rule2943 #-} + rule2943 = \ _beta -> + _beta + {-# INLINE rule2944 #-} + rule2944 = \ ((_patternIbetaUnique) :: Int) -> + _patternIbetaUnique + {-# INLINE rule2945 #-} + rule2945 = \ _constraints -> + _constraints + {-# INLINE rule2946 #-} + rule2946 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule2947 #-} + rule2947 = \ ((_patternIelements) :: [PatternElement] ) -> + _patternIelements + {-# INLINE rule2948 #-} + rule2948 = \ ((_patternIpatternMatchWarnings) :: [Warning]) -> + _patternIpatternMatchWarnings + {-# INLINE rule2949 #-} + rule2949 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2950 #-} + rule2950 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2951 #-} + rule2951 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2952 #-} + rule2952 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2953 #-} + rule2953 = \ _parentTree -> + _parentTree + {-# INLINE rule2954 #-} + rule2954 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_Wildcard #-} +sem_Pattern_Wildcard :: T_Range -> T_Pattern +sem_Pattern_Wildcard arg_range_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2955 _lhsIbetaUnique + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2956 () + _constraints = rule2957 () + _beta = rule2958 _lhsIbetaUnique + _localInfo = rule2959 _beta _lhsImonos _self + _parentTree = rule2960 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2961 _parentTree + _lhsOelements :: [PatternElement] + _lhsOelements = rule2962 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2963 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2964 () + _self = rule2965 _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2966 _self + _lhsObeta :: Tp + _lhsObeta = rule2967 _beta + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2968 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule2969 _lhsIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2970 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2955 #-} + rule2955 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule2956 #-} + rule2956 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule2957 #-} + rule2957 = \ (_ :: ()) -> + emptyTree + {-# INLINE rule2958 #-} + rule2958 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule2959 #-} + rule2959 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Pat _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule2960 #-} + rule2960 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule2961 #-} + rule2961 = \ _parentTree -> + _parentTree + {-# INLINE rule2962 #-} + rule2962 = \ (_ :: ()) -> + [WildcardElement] + {-# INLINE rule2963 #-} + rule2963 = \ (_ :: ()) -> + [] + {-# INLINE rule2964 #-} + rule2964 = \ (_ :: ()) -> + [] + {-# INLINE rule2965 #-} + rule2965 = \ ((_rangeIself) :: Range) -> + Pattern_Wildcard _rangeIself + {-# INLINE rule2966 #-} + rule2966 = \ _self -> + _self + {-# INLINE rule2967 #-} + rule2967 = \ _beta -> + _beta + {-# INLINE rule2968 #-} + rule2968 = \ _constraints -> + _constraints + {-# INLINE rule2969 #-} + rule2969 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2970 #-} + rule2970 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_Irrefutable #-} +sem_Pattern_Irrefutable :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Irrefutable arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIbeta _patternIbetaUnique _patternIconstraints _patternIcounter _patternIelements _patternIenvironment _patternIinfoTree _patternIpatVarNames _patternIpatternMatchWarnings _patternIself _patternIunboundNames) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternObetaUnique _patternOcounter _patternOimportEnvironment _patternOmonos _patternOnamesInScope _patternOparentTree _patternOpatternMatchWarnings) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2971 _patternIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2972 _patternIunboundNames + _self = rule2973 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2974 _self + _lhsObeta :: Tp + _lhsObeta = rule2975 _patternIbeta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2976 _patternIbetaUnique + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2977 _patternIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule2978 _patternIcounter + _lhsOelements :: [PatternElement] + _lhsOelements = rule2979 _patternIelements + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule2980 _patternIenvironment + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule2981 _patternIinfoTree + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule2982 _patternIpatternMatchWarnings + _patternObetaUnique = rule2983 _lhsIbetaUnique + _patternOcounter = rule2984 _lhsIcounter + _patternOimportEnvironment = rule2985 _lhsIimportEnvironment + _patternOmonos = rule2986 _lhsImonos + _patternOnamesInScope = rule2987 _lhsInamesInScope + _patternOparentTree = rule2988 _lhsIparentTree + _patternOpatternMatchWarnings = rule2989 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2971 #-} + rule2971 = \ ((_patternIpatVarNames) :: Names) -> + _patternIpatVarNames + {-# INLINE rule2972 #-} + rule2972 = \ ((_patternIunboundNames) :: Names) -> + _patternIunboundNames + {-# INLINE rule2973 #-} + rule2973 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Irrefutable _rangeIself _patternIself + {-# INLINE rule2974 #-} + rule2974 = \ _self -> + _self + {-# INLINE rule2975 #-} + rule2975 = \ ((_patternIbeta) :: Tp) -> + _patternIbeta + {-# INLINE rule2976 #-} + rule2976 = \ ((_patternIbetaUnique) :: Int) -> + _patternIbetaUnique + {-# INLINE rule2977 #-} + rule2977 = \ ((_patternIconstraints) :: ConstraintSet) -> + _patternIconstraints + {-# INLINE rule2978 #-} + rule2978 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule2979 #-} + rule2979 = \ ((_patternIelements) :: [PatternElement] ) -> + _patternIelements + {-# INLINE rule2980 #-} + rule2980 = \ ((_patternIenvironment) :: PatternAssumptions) -> + _patternIenvironment + {-# INLINE rule2981 #-} + rule2981 = \ ((_patternIinfoTree) :: InfoTree) -> + _patternIinfoTree + {-# INLINE rule2982 #-} + rule2982 = \ ((_patternIpatternMatchWarnings) :: [Warning]) -> + _patternIpatternMatchWarnings + {-# INLINE rule2983 #-} + rule2983 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2984 #-} + rule2984 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2985 #-} + rule2985 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule2986 #-} + rule2986 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule2987 #-} + rule2987 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2988 #-} + rule2988 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule2989 #-} + rule2989 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_Successor #-} +sem_Pattern_Successor :: T_Range -> T_Name -> T_Literal -> T_Pattern +sem_Pattern_Successor arg_range_ arg_name_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Literal_vOut85 _literalIelements _literalIliteralType _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _infoTree = rule2990 () + (_beta,_constraints,_environment) = rule2991 () + _lhsOelements :: [PatternElement] + _lhsOelements = rule2992 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2993 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2994 () + _self = rule2995 _literalIself _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2996 _self + _lhsObeta :: Tp + _lhsObeta = rule2997 _beta + _lhsObetaUnique :: Int + _lhsObetaUnique = rule2998 _lhsIbetaUnique + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule2999 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule3000 _lhsIcounter + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule3001 _environment + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3002 _infoTree + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3003 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2990 #-} + rule2990 = \ (_ :: ()) -> + globalInfoError + {-# INLINE rule2991 #-} + rule2991 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "Pattern.Successor" + {-# INLINE rule2992 #-} + rule2992 = \ (_ :: ()) -> + pmError "Pattern_Successor.elements" "Successors are not supported" + {-# INLINE rule2993 #-} + rule2993 = \ (_ :: ()) -> + [] + {-# INLINE rule2994 #-} + rule2994 = \ (_ :: ()) -> + [] + {-# INLINE rule2995 #-} + rule2995 = \ ((_literalIself) :: Literal) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Successor _rangeIself _nameIself _literalIself + {-# INLINE rule2996 #-} + rule2996 = \ _self -> + _self + {-# INLINE rule2997 #-} + rule2997 = \ _beta -> + _beta + {-# INLINE rule2998 #-} + rule2998 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule2999 #-} + rule2999 = \ _constraints -> + _constraints + {-# INLINE rule3000 #-} + rule3000 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3001 #-} + rule3001 = \ _environment -> + _environment + {-# INLINE rule3002 #-} + rule3002 = \ _infoTree -> + _infoTree + {-# INLINE rule3003 #-} + rule3003 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings +{-# NOINLINE sem_Pattern_NegateFloat #-} +sem_Pattern_NegateFloat :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_NegateFloat arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIelements _literalIliteralType _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3004 _lhsIbetaUnique + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule3005 () + _constraints = rule3006 _newcon + _beta = rule3007 _lhsIbetaUnique + _newcon = rule3008 _beta _cinfo + _cinfo = rule3009 _parentTree + _localInfo = rule3010 _beta _lhsImonos _self + _parentTree = rule3011 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3012 _parentTree + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule3013 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3014 () + _self = rule3015 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule3016 _self + _lhsObeta :: Tp + _lhsObeta = rule3017 _beta + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3018 _constraints + _lhsOcounter :: Int + _lhsOcounter = rule3019 _lhsIcounter + _lhsOelements :: [PatternElement] + _lhsOelements = rule3020 _literalIelements + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3021 _lhsIpatternMatchWarnings + __result_ = T_Pattern_vOut118 _lhsObeta _lhsObetaUnique _lhsOconstraints _lhsOcounter _lhsOelements _lhsOenvironment _lhsOinfoTree _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule3004 #-} + rule3004 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule3005 #-} + rule3005 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule3006 #-} + rule3006 = \ _newcon -> + listTree _newcon + {-# INLINE rule3007 #-} + rule3007 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule3008 #-} + rule3008 = \ _beta _cinfo -> + [ (floatType .==. _beta) _cinfo ] + {-# INLINE rule3009 #-} + rule3009 = \ _parentTree -> + resultConstraint "pattern negation" _parentTree + [ FolkloreConstraint ] + {-# INLINE rule3010 #-} + rule3010 = \ _beta ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Pat _self + , assignedType = Just _beta + , monos = _lhsImonos + } + {-# INLINE rule3011 #-} + rule3011 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule3012 #-} + rule3012 = \ _parentTree -> + _parentTree + {-# INLINE rule3013 #-} + rule3013 = \ (_ :: ()) -> + [] + {-# INLINE rule3014 #-} + rule3014 = \ (_ :: ()) -> + [] + {-# INLINE rule3015 #-} + rule3015 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_NegateFloat _rangeIself _literalIself + {-# INLINE rule3016 #-} + rule3016 = \ _self -> + _self + {-# INLINE rule3017 #-} + rule3017 = \ _beta -> + _beta + {-# INLINE rule3018 #-} + rule3018 = \ _constraints -> + _constraints + {-# INLINE rule3019 #-} + rule3019 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3020 #-} + rule3020 = \ ((_literalIelements) :: [PatternElement] ) -> + _literalIelements + {-# INLINE rule3021 #-} + rule3021 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + +-- Patterns ---------------------------------------------------- +-- wrapper +data Inh_Patterns = Inh_Patterns { betaUnique_Inh_Patterns :: (Int), counter_Inh_Patterns :: (Int), importEnvironment_Inh_Patterns :: (ImportEnvironment), monos_Inh_Patterns :: (Monos), namesInScope_Inh_Patterns :: (Names), parentTree_Inh_Patterns :: (InfoTree), patternMatchWarnings_Inh_Patterns :: ([Warning]) } +data Syn_Patterns = Syn_Patterns { betaUnique_Syn_Patterns :: (Int), betas_Syn_Patterns :: (Tps), constraintslist_Syn_Patterns :: (ConstraintSets), counter_Syn_Patterns :: (Int), elementss_Syn_Patterns :: ([ [PatternElement] ]), environment_Syn_Patterns :: (PatternAssumptions), infoTrees_Syn_Patterns :: (InfoTrees), numberOfPatterns_Syn_Patterns :: (Int), patVarNames_Syn_Patterns :: (Names), patternMatchWarnings_Syn_Patterns :: ([Warning]), self_Syn_Patterns :: (Patterns), unboundNames_Syn_Patterns :: (Names) } +{-# INLINABLE wrap_Patterns #-} +wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) +wrap_Patterns (T_Patterns act) (Inh_Patterns _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Patterns_vIn121 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings + (T_Patterns_vOut121 _lhsObetaUnique _lhsObetas _lhsOconstraintslist _lhsOcounter _lhsOelementss _lhsOenvironment _lhsOinfoTrees _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames) <- return (inv_Patterns_s122 sem arg) + return (Syn_Patterns _lhsObetaUnique _lhsObetas _lhsOconstraintslist _lhsOcounter _lhsOelementss _lhsOenvironment _lhsOinfoTrees _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_Patterns #-} +sem_Patterns :: Patterns -> T_Patterns +sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) + +-- semantic domain +newtype T_Patterns = T_Patterns { + attach_T_Patterns :: Identity (T_Patterns_s122 ) + } +newtype T_Patterns_s122 = C_Patterns_s122 { + inv_Patterns_s122 :: (T_Patterns_v121 ) + } +data T_Patterns_s123 = C_Patterns_s123 +type T_Patterns_v121 = (T_Patterns_vIn121 ) -> (T_Patterns_vOut121 ) +data T_Patterns_vIn121 = T_Patterns_vIn121 (Int) (Int) (ImportEnvironment) (Monos) (Names) (InfoTree) ([Warning]) +data T_Patterns_vOut121 = T_Patterns_vOut121 (Int) (Tps) (ConstraintSets) (Int) ([ [PatternElement] ]) (PatternAssumptions) (InfoTrees) (Int) (Names) ([Warning]) (Patterns) (Names) +{-# NOINLINE sem_Patterns_Cons #-} +sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns +sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _hdX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) + _tlX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) + (T_Pattern_vOut118 _hdIbeta _hdIbetaUnique _hdIconstraints _hdIcounter _hdIelements _hdIenvironment _hdIinfoTree _hdIpatVarNames _hdIpatternMatchWarnings _hdIself _hdIunboundNames) = inv_Pattern_s119 _hdX119 (T_Pattern_vIn118 _hdObetaUnique _hdOcounter _hdOimportEnvironment _hdOmonos _hdOnamesInScope _hdOparentTree _hdOpatternMatchWarnings) + (T_Patterns_vOut121 _tlIbetaUnique _tlIbetas _tlIconstraintslist _tlIcounter _tlIelementss _tlIenvironment _tlIinfoTrees _tlInumberOfPatterns _tlIpatVarNames _tlIpatternMatchWarnings _tlIself _tlIunboundNames) = inv_Patterns_s122 _tlX122 (T_Patterns_vIn121 _tlObetaUnique _tlOcounter _tlOimportEnvironment _tlOmonos _tlOnamesInScope _tlOparentTree _tlOpatternMatchWarnings) + _lhsObetas :: Tps + _lhsObetas = rule3022 _hdIbeta _tlIbetas + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule3023 _hdIenvironment _tlIenvironment + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule3024 _tlInumberOfPatterns + _lhsOconstraintslist :: ConstraintSets + _lhsOconstraintslist = rule3025 _hdIconstraints _tlIconstraintslist + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule3026 _hdIinfoTree _tlIinfoTrees + _lhsOelementss :: [ [PatternElement] ] + _lhsOelementss = rule3027 _hdIelements _tlIelementss + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule3028 _hdIpatVarNames _tlIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3029 _hdIunboundNames _tlIunboundNames + _self = rule3030 _hdIself _tlIself + _lhsOself :: Patterns + _lhsOself = rule3031 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3032 _tlIbetaUnique + _lhsOcounter :: Int + _lhsOcounter = rule3033 _tlIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3034 _tlIpatternMatchWarnings + _hdObetaUnique = rule3035 _lhsIbetaUnique + _hdOcounter = rule3036 _lhsIcounter + _hdOimportEnvironment = rule3037 _lhsIimportEnvironment + _hdOmonos = rule3038 _lhsImonos + _hdOnamesInScope = rule3039 _lhsInamesInScope + _hdOparentTree = rule3040 _lhsIparentTree + _hdOpatternMatchWarnings = rule3041 _lhsIpatternMatchWarnings + _tlObetaUnique = rule3042 _hdIbetaUnique + _tlOcounter = rule3043 _hdIcounter + _tlOimportEnvironment = rule3044 _lhsIimportEnvironment + _tlOmonos = rule3045 _lhsImonos + _tlOnamesInScope = rule3046 _lhsInamesInScope + _tlOparentTree = rule3047 _lhsIparentTree + _tlOpatternMatchWarnings = rule3048 _hdIpatternMatchWarnings + __result_ = T_Patterns_vOut121 _lhsObetaUnique _lhsObetas _lhsOconstraintslist _lhsOcounter _lhsOelementss _lhsOenvironment _lhsOinfoTrees _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule3022 #-} + rule3022 = \ ((_hdIbeta) :: Tp) ((_tlIbetas) :: Tps) -> + _hdIbeta : _tlIbetas + {-# INLINE rule3023 #-} + rule3023 = \ ((_hdIenvironment) :: PatternAssumptions) ((_tlIenvironment) :: PatternAssumptions) -> + _hdIenvironment `M.union` _tlIenvironment + {-# INLINE rule3024 #-} + rule3024 = \ ((_tlInumberOfPatterns) :: Int) -> + 1 + _tlInumberOfPatterns + {-# INLINE rule3025 #-} + rule3025 = \ ((_hdIconstraints) :: ConstraintSet) ((_tlIconstraintslist) :: ConstraintSets) -> + _hdIconstraints : _tlIconstraintslist + {-# INLINE rule3026 #-} + rule3026 = \ ((_hdIinfoTree) :: InfoTree) ((_tlIinfoTrees) :: InfoTrees) -> + _hdIinfoTree : _tlIinfoTrees + {-# INLINE rule3027 #-} + rule3027 = \ ((_hdIelements) :: [PatternElement] ) ((_tlIelementss) :: [ [PatternElement] ]) -> + _hdIelements : _tlIelementss + {-# INLINE rule3028 #-} + rule3028 = \ ((_hdIpatVarNames) :: Names) ((_tlIpatVarNames) :: Names) -> + _hdIpatVarNames ++ _tlIpatVarNames + {-# INLINE rule3029 #-} + rule3029 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule3030 #-} + rule3030 = \ ((_hdIself) :: Pattern) ((_tlIself) :: Patterns) -> + (:) _hdIself _tlIself + {-# INLINE rule3031 #-} + rule3031 = \ _self -> + _self + {-# INLINE rule3032 #-} + rule3032 = \ ((_tlIbetaUnique) :: Int) -> + _tlIbetaUnique + {-# INLINE rule3033 #-} + rule3033 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule3034 #-} + rule3034 = \ ((_tlIpatternMatchWarnings) :: [Warning]) -> + _tlIpatternMatchWarnings + {-# INLINE rule3035 #-} + rule3035 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3036 #-} + rule3036 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3037 #-} + rule3037 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3038 #-} + rule3038 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3039 #-} + rule3039 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3040 #-} + rule3040 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule3041 #-} + rule3041 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3042 #-} + rule3042 = \ ((_hdIbetaUnique) :: Int) -> + _hdIbetaUnique + {-# INLINE rule3043 #-} + rule3043 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule3044 #-} + rule3044 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3045 #-} + rule3045 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3046 #-} + rule3046 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3047 #-} + rule3047 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule3048 #-} + rule3048 = \ ((_hdIpatternMatchWarnings) :: [Warning]) -> + _hdIpatternMatchWarnings +{-# NOINLINE sem_Patterns_Nil #-} +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 _lhsIbetaUnique _lhsIcounter _lhsIimportEnvironment _lhsImonos _lhsInamesInScope _lhsIparentTree _lhsIpatternMatchWarnings) -> ( let + _lhsObetas :: Tps + _lhsObetas = rule3049 () + _lhsOenvironment :: PatternAssumptions + _lhsOenvironment = rule3050 () + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule3051 () + _lhsOconstraintslist :: ConstraintSets + _lhsOconstraintslist = rule3052 () + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule3053 () + _lhsOelementss :: [ [PatternElement] ] + _lhsOelementss = rule3054 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule3055 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3056 () + _self = rule3057 () + _lhsOself :: Patterns + _lhsOself = rule3058 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3059 _lhsIbetaUnique + _lhsOcounter :: Int + _lhsOcounter = rule3060 _lhsIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3061 _lhsIpatternMatchWarnings + __result_ = T_Patterns_vOut121 _lhsObetaUnique _lhsObetas _lhsOconstraintslist _lhsOcounter _lhsOelementss _lhsOenvironment _lhsOinfoTrees _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule3049 #-} + rule3049 = \ (_ :: ()) -> + [] + {-# INLINE rule3050 #-} + rule3050 = \ (_ :: ()) -> + noAssumptions + {-# INLINE rule3051 #-} + rule3051 = \ (_ :: ()) -> + 0 + {-# INLINE rule3052 #-} + rule3052 = \ (_ :: ()) -> + [] + {-# INLINE rule3053 #-} + rule3053 = \ (_ :: ()) -> + [] + {-# INLINE rule3054 #-} + rule3054 = \ (_ :: ()) -> + [] + {-# INLINE rule3055 #-} + rule3055 = \ (_ :: ()) -> + [] + {-# INLINE rule3056 #-} + rule3056 = \ (_ :: ()) -> + [] + {-# INLINE rule3057 #-} + rule3057 = \ (_ :: ()) -> + [] + {-# INLINE rule3058 #-} + rule3058 = \ _self -> + _self + {-# INLINE rule3059 #-} + rule3059 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3060 #-} + rule3060 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3061 #-} + rule3061 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + +-- Position ---------------------------------------------------- +-- wrapper +data Inh_Position = Inh_Position { } +data Syn_Position = Syn_Position { self_Syn_Position :: (Position) } +{-# INLINABLE wrap_Position #-} +wrap_Position :: T_Position -> Inh_Position -> (Syn_Position ) +wrap_Position (T_Position act) (Inh_Position ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Position_vIn124 + (T_Position_vOut124 _lhsOself) <- return (inv_Position_s125 sem arg) + return (Syn_Position _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Position #-} +sem_Position :: Position -> T_Position +sem_Position ( Position_Position filename_ line_ column_ ) = sem_Position_Position filename_ line_ column_ +sem_Position ( Position_Unknown ) = sem_Position_Unknown + +-- semantic domain +newtype T_Position = T_Position { + attach_T_Position :: Identity (T_Position_s125 ) + } +newtype T_Position_s125 = C_Position_s125 { + inv_Position_s125 :: (T_Position_v124 ) + } +data T_Position_s126 = C_Position_s126 +type T_Position_v124 = (T_Position_vIn124 ) -> (T_Position_vOut124 ) +data T_Position_vIn124 = T_Position_vIn124 +data T_Position_vOut124 = T_Position_vOut124 (Position) +{-# NOINLINE sem_Position_Position #-} +sem_Position_Position :: (String) -> (Int) -> (Int) -> T_Position +sem_Position_Position arg_filename_ arg_line_ arg_column_ = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule3062 arg_column_ arg_filename_ arg_line_ + _lhsOself :: Position + _lhsOself = rule3063 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule3062 #-} + rule3062 = \ column_ filename_ line_ -> + Position_Position filename_ line_ column_ + {-# INLINE rule3063 #-} + rule3063 = \ _self -> + _self +{-# NOINLINE sem_Position_Unknown #-} +sem_Position_Unknown :: T_Position +sem_Position_Unknown = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule3064 () + _lhsOself :: Position + _lhsOself = rule3065 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule3064 #-} + rule3064 = \ (_ :: ()) -> + Position_Unknown + {-# INLINE rule3065 #-} + rule3065 = \ _self -> + _self + +-- Qualifier --------------------------------------------------- +-- wrapper +data Inh_Qualifier = Inh_Qualifier { allPatterns_Inh_Qualifier :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_Qualifier :: (M.Map NameWithRange TpScheme), assumptions_Inh_Qualifier :: (Assumptions), availablePredicates_Inh_Qualifier :: (Predicates), betaUnique_Inh_Qualifier :: (Int), classEnvironment_Inh_Qualifier :: (ClassEnvironment), collectErrors_Inh_Qualifier :: (TypeErrors), collectWarnings_Inh_Qualifier :: (Warnings), constraints_Inh_Qualifier :: (ConstraintSet), counter_Inh_Qualifier :: (Int), currentChunk_Inh_Qualifier :: (Int), dictionaryEnvironment_Inh_Qualifier :: (DictionaryEnvironment), importEnvironment_Inh_Qualifier :: (ImportEnvironment), matchIO_Inh_Qualifier :: (IO ()), monos_Inh_Qualifier :: (Monos), namesInScope_Inh_Qualifier :: (Names), orderedTypeSynonyms_Inh_Qualifier :: (OrderedTypeSynonyms), parentTree_Inh_Qualifier :: (InfoTree), patternMatchWarnings_Inh_Qualifier :: ([Warning]), substitution_Inh_Qualifier :: (FixpointSubstitution), typeschemeMap_Inh_Qualifier :: (M.Map Int (Scheme Predicates)), unboundNames_Inh_Qualifier :: (Names), uniqueChunk_Inh_Qualifier :: (Int), uniqueSecondRound_Inh_Qualifier :: (Int) } +data Syn_Qualifier = Syn_Qualifier { assumptions_Syn_Qualifier :: (Assumptions), betaUnique_Syn_Qualifier :: (Int), collectErrors_Syn_Qualifier :: (TypeErrors), collectInstances_Syn_Qualifier :: ([(Name, Instance)]), collectWarnings_Syn_Qualifier :: (Warnings), constraints_Syn_Qualifier :: (ConstraintSet), counter_Syn_Qualifier :: (Int), dictionaryEnvironment_Syn_Qualifier :: (DictionaryEnvironment), infoTree_Syn_Qualifier :: (InfoTree), matchIO_Syn_Qualifier :: (IO ()), monos_Syn_Qualifier :: (Monos), namesInScope_Syn_Qualifier :: (Names), patternMatchWarnings_Syn_Qualifier :: ([Warning]), self_Syn_Qualifier :: (Qualifier), unboundNames_Syn_Qualifier :: (Names), uniqueChunk_Syn_Qualifier :: (Int), uniqueSecondRound_Syn_Qualifier :: (Int) } +{-# INLINABLE wrap_Qualifier #-} +wrap_Qualifier :: T_Qualifier -> Inh_Qualifier -> (Syn_Qualifier ) +wrap_Qualifier (T_Qualifier act) (Inh_Qualifier _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifier_vIn127 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound + (T_Qualifier_vOut127 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) <- return (inv_Qualifier_s128 sem arg) + return (Syn_Qualifier _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) + ) + +-- cata +{-# NOINLINE sem_Qualifier #-} +sem_Qualifier :: Qualifier -> T_Qualifier +sem_Qualifier ( Qualifier_Guard range_ guard_ ) = sem_Qualifier_Guard ( sem_Range range_ ) ( sem_Expression guard_ ) +sem_Qualifier ( Qualifier_Let range_ declarations_ ) = sem_Qualifier_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Qualifier ( Qualifier_Generator range_ pattern_ expression_ ) = sem_Qualifier_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Qualifier ( Qualifier_Empty range_ ) = sem_Qualifier_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Qualifier = T_Qualifier { + attach_T_Qualifier :: Identity (T_Qualifier_s128 ) + } +newtype T_Qualifier_s128 = C_Qualifier_s128 { + inv_Qualifier_s128 :: (T_Qualifier_v127 ) + } +data T_Qualifier_s129 = C_Qualifier_s129 +type T_Qualifier_v127 = (T_Qualifier_vIn127 ) -> (T_Qualifier_vOut127 ) +data T_Qualifier_vIn127 = T_Qualifier_vIn127 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Assumptions) (Predicates) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (ConstraintSet) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Names) (Int) (Int) +data T_Qualifier_vOut127 = T_Qualifier_vOut127 (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (DictionaryEnvironment) (InfoTree) (IO ()) (Monos) (Names) ([Warning]) (Qualifier) (Names) (Int) (Int) +{-# NOINLINE sem_Qualifier_Guard #-} +sem_Qualifier_Guard :: T_Range -> T_Expression -> T_Qualifier +sem_Qualifier_Guard arg_range_ arg_guard_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIassumptions _guardIbeta _guardIbetaUnique _guardIcollectErrors _guardIcollectInstances _guardIcollectWarnings _guardIconstraints _guardIcounter _guardIdictionaryEnvironment _guardIinfoTree _guardImatchIO _guardImatches _guardIpatternMatchWarnings _guardIself _guardIunboundNames _guardIuniqueChunk _guardIuniqueSecondRound) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 _guardOallPatterns _guardOallTypeSchemes _guardOavailablePredicates _guardObetaUnique _guardOclassEnvironment _guardOcollectErrors _guardOcollectWarnings _guardOcounter _guardOcurrentChunk _guardOdictionaryEnvironment _guardOimportEnvironment _guardOmatchIO _guardOmonos _guardOnamesInScope _guardOorderedTypeSynonyms _guardOparentTree _guardOpatternMatchWarnings _guardOsubstitution _guardOtryPatterns _guardOtypeschemeMap _guardOuniqueChunk _guardOuniqueSecondRound) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3066 _guardIassumptions _lhsIassumptions + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3067 _locConstraints + _locConstraints = rule3068 _guardIconstraints _lhsIconstraints _newcon + _newcon = rule3069 _cinfo _guardIbeta + _cinfo = rule3070 _parentTree + _localInfo = rule3071 _lhsImonos _self + _parentTree = rule3072 _guardIinfoTree _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3073 _parentTree + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3074 _guardIunboundNames _lhsIunboundNames + _guardOtryPatterns = rule3075 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3076 _guardIcollectInstances + _self = rule3077 _guardIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule3078 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3079 _guardIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3080 _guardIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3081 _guardIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule3082 _guardIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3083 _guardIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3084 _guardImatchIO + _lhsOmonos :: Monos + _lhsOmonos = rule3085 _lhsImonos + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3086 _lhsInamesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3087 _guardIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3088 _guardIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3089 _guardIuniqueSecondRound + _guardOallPatterns = rule3090 _lhsIallPatterns + _guardOallTypeSchemes = rule3091 _lhsIallTypeSchemes + _guardOavailablePredicates = rule3092 _lhsIavailablePredicates + _guardObetaUnique = rule3093 _lhsIbetaUnique + _guardOclassEnvironment = rule3094 _lhsIclassEnvironment + _guardOcollectErrors = rule3095 _lhsIcollectErrors + _guardOcollectWarnings = rule3096 _lhsIcollectWarnings + _guardOcounter = rule3097 _lhsIcounter + _guardOcurrentChunk = rule3098 _lhsIcurrentChunk + _guardOdictionaryEnvironment = rule3099 _lhsIdictionaryEnvironment + _guardOimportEnvironment = rule3100 _lhsIimportEnvironment + _guardOmatchIO = rule3101 _lhsImatchIO + _guardOmonos = rule3102 _lhsImonos + _guardOnamesInScope = rule3103 _lhsInamesInScope + _guardOorderedTypeSynonyms = rule3104 _lhsIorderedTypeSynonyms + _guardOparentTree = rule3105 _parentTree + _guardOpatternMatchWarnings = rule3106 _lhsIpatternMatchWarnings + _guardOsubstitution = rule3107 _lhsIsubstitution + _guardOtypeschemeMap = rule3108 _lhsItypeschemeMap + _guardOuniqueChunk = rule3109 _lhsIuniqueChunk + _guardOuniqueSecondRound = rule3110 _lhsIuniqueSecondRound + __result_ = T_Qualifier_vOut127 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule3066 #-} + rule3066 = \ ((_guardIassumptions) :: Assumptions) ((_lhsIassumptions) :: Assumptions) -> + _lhsIassumptions `combine` _guardIassumptions + {-# INLINE rule3067 #-} + rule3067 = \ _locConstraints -> + _locConstraints + {-# INLINE rule3068 #-} + rule3068 = \ ((_guardIconstraints) :: ConstraintSet) ((_lhsIconstraints) :: ConstraintSet) _newcon -> + Node [ _newcon .<. _guardIconstraints + , _lhsIconstraints + ] + {-# INLINE rule3069 #-} + rule3069 = \ _cinfo ((_guardIbeta) :: Tp) -> + [ (_guardIbeta .==. boolType) _cinfo ] + {-# INLINE rule3070 #-} + rule3070 = \ _parentTree -> + orphanConstraint 0 "boolean qualifier" _parentTree + [] + {-# INLINE rule3071 #-} + rule3071 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Qual _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3072 #-} + rule3072 = \ ((_guardIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [_guardIinfoTree] + {-# INLINE rule3073 #-} + rule3073 = \ _parentTree -> + _parentTree + {-# INLINE rule3074 #-} + rule3074 = \ ((_guardIunboundNames) :: Names) ((_lhsIunboundNames) :: Names) -> + _guardIunboundNames ++ _lhsIunboundNames + {-# INLINE rule3075 #-} + rule3075 = \ (_ :: ()) -> + [] + {-# INLINE rule3076 #-} + rule3076 = \ ((_guardIcollectInstances) :: [(Name, Instance)]) -> + _guardIcollectInstances + {-# INLINE rule3077 #-} + rule3077 = \ ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + Qualifier_Guard _rangeIself _guardIself + {-# INLINE rule3078 #-} + rule3078 = \ _self -> + _self + {-# INLINE rule3079 #-} + rule3079 = \ ((_guardIbetaUnique) :: Int) -> + _guardIbetaUnique + {-# INLINE rule3080 #-} + rule3080 = \ ((_guardIcollectErrors) :: TypeErrors) -> + _guardIcollectErrors + {-# INLINE rule3081 #-} + rule3081 = \ ((_guardIcollectWarnings) :: Warnings) -> + _guardIcollectWarnings + {-# INLINE rule3082 #-} + rule3082 = \ ((_guardIcounter) :: Int) -> + _guardIcounter + {-# INLINE rule3083 #-} + rule3083 = \ ((_guardIdictionaryEnvironment) :: DictionaryEnvironment) -> + _guardIdictionaryEnvironment + {-# INLINE rule3084 #-} + rule3084 = \ ((_guardImatchIO) :: IO ()) -> + _guardImatchIO + {-# INLINE rule3085 #-} + rule3085 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3086 #-} + rule3086 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3087 #-} + rule3087 = \ ((_guardIpatternMatchWarnings) :: [Warning]) -> + _guardIpatternMatchWarnings + {-# INLINE rule3088 #-} + rule3088 = \ ((_guardIuniqueChunk) :: Int) -> + _guardIuniqueChunk + {-# INLINE rule3089 #-} + rule3089 = \ ((_guardIuniqueSecondRound) :: Int) -> + _guardIuniqueSecondRound + {-# INLINE rule3090 #-} + rule3090 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3091 #-} + rule3091 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule3092 #-} + rule3092 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3093 #-} + rule3093 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3094 #-} + rule3094 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3095 #-} + rule3095 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3096 #-} + rule3096 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3097 #-} + rule3097 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3098 #-} + rule3098 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3099 #-} + rule3099 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3100 #-} + rule3100 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3101 #-} + rule3101 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3102 #-} + rule3102 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3103 #-} + rule3103 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3104 #-} + rule3104 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3105 #-} + rule3105 = \ _parentTree -> + _parentTree + {-# INLINE rule3106 #-} + rule3106 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3107 #-} + rule3107 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3108 #-} + rule3108 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3109 #-} + rule3109 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3110 #-} + rule3110 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Qualifier_Let #-} +sem_Qualifier_Let :: T_Range -> T_Declarations -> T_Qualifier +sem_Qualifier_Let arg_range_ arg_declarations_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIbetaUnique _declarationsIbindingGroups _declarationsIcollectErrors _declarationsIcollectInstances _declarationsIcollectWarnings _declarationsIcounter _declarationsIdeclVarNames _declarationsIdictionaryEnvironment _declarationsIinfoTrees _declarationsImatchIO _declarationsIpatternMatchWarnings _declarationsIrestrictedNames _declarationsIself _declarationsIsimplePatNames _declarationsItypeSignatures _declarationsIunboundNames _declarationsIuniqueChunk) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOallPatterns _declarationsOallTypeSchemes _declarationsOavailablePredicates _declarationsObetaUnique _declarationsObindingGroups _declarationsOclassEnvironment _declarationsOcollectErrors _declarationsOcollectWarnings _declarationsOcounter _declarationsOcurrentChunk _declarationsOdictionaryEnvironment _declarationsOimportEnvironment _declarationsOinheritedBDG _declarationsOmatchIO _declarationsOmonos _declarationsOnamesInScope _declarationsOorderedTypeSynonyms _declarationsOparentTree _declarationsOpatternMatchWarnings _declarationsOsubstitution _declarationsOtypeSignatures _declarationsOtypeschemeMap _declarationsOuniqueChunk) + _declarationsObindingGroups = rule3111 () + _lhsOassumptions :: Assumptions + _lhsOconstraints :: ConstraintSet + _lhsObetaUnique :: Int + (_lhsOassumptions,_lhsOconstraints,_inheritedBDG,_chunkNr,_lhsObetaUnique,_implicitsFM) = rule3112 _declarationsIbetaUnique _declarationsIbindingGroups _declarationsItypeSignatures _declarationsIuniqueChunk _lhsIassumptions _lhsIconstraints _lhsIcurrentChunk _lhsImonos + _inferredTypes = rule3113 _implicitsFM _lhsItypeschemeMap + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3114 _declarationsIcollectWarnings _declarationsIsimplePatNames _inferredTypes + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3115 _declarationsIcollectErrors _declarationsIrestrictedNames _inferredTypes + _allTypeSchemes = rule3116 _lhsIallTypeSchemes _localTypes + _localTypes = rule3117 _declarationsIbindingGroups _declarationsItypeSignatures _inferredTypes + _declarationsOtypeSignatures = rule3118 () + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3119 _chunkNr + _localInfo = rule3120 _lhsImonos _self + _declInfo = rule3121 _declarationsIself _lhsImonos + _thisTree = rule3122 _declTree _lhsIparentTree _localInfo + _declTree = rule3123 _declInfo _declarationsIinfoTrees _thisTree + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3124 _thisTree + _declarationsOparentTree = rule3125 _declTree + (_collectTypeConstructors,_collectValueConstructors,_collectTypeSynonyms,_collectConstructorEnv,_derivedFunctions,_operatorFixities) = rule3126 () + (_namesInScope,_unboundNames,_scopeInfo) = rule3127 _declarationsIdeclVarNames _declarationsIunboundNames _lhsInamesInScope _lhsIunboundNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3128 _unboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3129 _declarationsIcollectInstances + _self = rule3130 _declarationsIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule3131 _self + _lhsOcounter :: Int + _lhsOcounter = rule3132 _declarationsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3133 _declarationsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3134 _declarationsImatchIO + _lhsOmonos :: Monos + _lhsOmonos = rule3135 _lhsImonos + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3136 _namesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3137 _declarationsIpatternMatchWarnings + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3138 _lhsIuniqueSecondRound + _declarationsOallPatterns = rule3139 _lhsIallPatterns + _declarationsOallTypeSchemes = rule3140 _allTypeSchemes + _declarationsOavailablePredicates = rule3141 _lhsIavailablePredicates + _declarationsObetaUnique = rule3142 _lhsIbetaUnique + _declarationsOclassEnvironment = rule3143 _lhsIclassEnvironment + _declarationsOcollectErrors = rule3144 _lhsIcollectErrors + _declarationsOcollectWarnings = rule3145 _lhsIcollectWarnings + _declarationsOcounter = rule3146 _lhsIcounter + _declarationsOcurrentChunk = rule3147 _lhsIcurrentChunk + _declarationsOdictionaryEnvironment = rule3148 _lhsIdictionaryEnvironment + _declarationsOimportEnvironment = rule3149 _lhsIimportEnvironment + _declarationsOinheritedBDG = rule3150 _inheritedBDG + _declarationsOmatchIO = rule3151 _lhsImatchIO + _declarationsOmonos = rule3152 _lhsImonos + _declarationsOnamesInScope = rule3153 _namesInScope + _declarationsOorderedTypeSynonyms = rule3154 _lhsIorderedTypeSynonyms + _declarationsOpatternMatchWarnings = rule3155 _lhsIpatternMatchWarnings + _declarationsOsubstitution = rule3156 _lhsIsubstitution + _declarationsOtypeschemeMap = rule3157 _lhsItypeschemeMap + _declarationsOuniqueChunk = rule3158 _lhsIuniqueChunk + __result_ = T_Qualifier_vOut127 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule3111 #-} + rule3111 = \ (_ :: ()) -> + [] + {-# INLINE rule3112 #-} + rule3112 = \ ((_declarationsIbetaUnique) :: Int) ((_declarationsIbindingGroups) :: BindingGroups) ((_declarationsItypeSignatures) :: TypeEnvironment) ((_declarationsIuniqueChunk) :: Int) ((_lhsIassumptions) :: Assumptions) ((_lhsIconstraints) :: ConstraintSet) ((_lhsIcurrentChunk) :: Int) ((_lhsImonos) :: Monos) -> + let inputBDG = (False, _lhsIcurrentChunk, _declarationsIuniqueChunk, _lhsImonos, _declarationsItypeSignatures, mybdggroup, _declarationsIbetaUnique) + mybdggroup = Just (_lhsIassumptions, [_lhsIconstraints]) + in performBindingGroup inputBDG _declarationsIbindingGroups + {-# INLINE rule3113 #-} + rule3113 = \ _implicitsFM ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + findInferredTypes _lhsItypeschemeMap _implicitsFM + {-# INLINE rule3114 #-} + rule3114 = \ ((_declarationsIcollectWarnings) :: Warnings) ((_declarationsIsimplePatNames) :: Names) _inferredTypes -> + missingTypeSignature False _declarationsIsimplePatNames _inferredTypes + ++ _declarationsIcollectWarnings + {-# INLINE rule3115 #-} + rule3115 = \ ((_declarationsIcollectErrors) :: TypeErrors) ((_declarationsIrestrictedNames) :: Names) _inferredTypes -> + restrictedNameErrors _inferredTypes _declarationsIrestrictedNames + ++ _declarationsIcollectErrors + {-# INLINE rule3116 #-} + rule3116 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) _localTypes -> + _localTypes `M.union` _lhsIallTypeSchemes + {-# INLINE rule3117 #-} + rule3117 = \ ((_declarationsIbindingGroups) :: BindingGroups) ((_declarationsItypeSignatures) :: TypeEnvironment) _inferredTypes -> + makeLocalTypeEnv (_declarationsItypeSignatures `M.union` _inferredTypes) _declarationsIbindingGroups + {-# INLINE rule3118 #-} + rule3118 = \ (_ :: ()) -> + M.empty + {-# INLINE rule3119 #-} + rule3119 = \ _chunkNr -> + _chunkNr + {-# INLINE rule3120 #-} + rule3120 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Qual _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3121 #-} + rule3121 = \ ((_declarationsIself) :: Declarations) ((_lhsImonos) :: Monos) -> + LocalInfo { self = UHA_Decls _declarationsIself + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3122 #-} + rule3122 = \ _declTree ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [_declTree] + {-# INLINE rule3123 #-} + rule3123 = \ _declInfo ((_declarationsIinfoTrees) :: InfoTrees) _thisTree -> + node _thisTree _declInfo _declarationsIinfoTrees + {-# INLINE rule3124 #-} + rule3124 = \ _thisTree -> + _thisTree + {-# INLINE rule3125 #-} + rule3125 = \ _declTree -> + _declTree + {-# INLINE rule3126 #-} + rule3126 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "toplevel Qualifier" + {-# INLINE rule3127 #-} + rule3127 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsIunboundNames) :: Names) -> + changeOfScope _declarationsIdeclVarNames (_declarationsIunboundNames ++ _lhsIunboundNames) _lhsInamesInScope + {-# INLINE rule3128 #-} + rule3128 = \ _unboundNames -> + _unboundNames + {-# INLINE rule3129 #-} + rule3129 = \ ((_declarationsIcollectInstances) :: [(Name, Instance)]) -> + _declarationsIcollectInstances + {-# INLINE rule3130 #-} + rule3130 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Qualifier_Let _rangeIself _declarationsIself + {-# INLINE rule3131 #-} + rule3131 = \ _self -> + _self + {-# INLINE rule3132 #-} + rule3132 = \ ((_declarationsIcounter) :: Int) -> + _declarationsIcounter + {-# INLINE rule3133 #-} + rule3133 = \ ((_declarationsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _declarationsIdictionaryEnvironment + {-# INLINE rule3134 #-} + rule3134 = \ ((_declarationsImatchIO) :: IO ()) -> + _declarationsImatchIO + {-# INLINE rule3135 #-} + rule3135 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3136 #-} + rule3136 = \ _namesInScope -> + _namesInScope + {-# INLINE rule3137 #-} + rule3137 = \ ((_declarationsIpatternMatchWarnings) :: [Warning]) -> + _declarationsIpatternMatchWarnings + {-# INLINE rule3138 #-} + rule3138 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule3139 #-} + rule3139 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3140 #-} + rule3140 = \ _allTypeSchemes -> + _allTypeSchemes + {-# INLINE rule3141 #-} + rule3141 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3142 #-} + rule3142 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3143 #-} + rule3143 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3144 #-} + rule3144 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3145 #-} + rule3145 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3146 #-} + rule3146 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3147 #-} + rule3147 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3148 #-} + rule3148 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3149 #-} + rule3149 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3150 #-} + rule3150 = \ _inheritedBDG -> + _inheritedBDG + {-# INLINE rule3151 #-} + rule3151 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3152 #-} + rule3152 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3153 #-} + rule3153 = \ _namesInScope -> + _namesInScope + {-# INLINE rule3154 #-} + rule3154 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3155 #-} + rule3155 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3156 #-} + rule3156 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3157 #-} + rule3157 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3158 #-} + rule3158 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Qualifier_Generator #-} +sem_Qualifier_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Qualifier +sem_Qualifier_Generator arg_range_ arg_pattern_ arg_expression_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIbeta _patternIbetaUnique _patternIconstraints _patternIcounter _patternIelements _patternIenvironment _patternIinfoTree _patternIpatVarNames _patternIpatternMatchWarnings _patternIself _patternIunboundNames) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternObetaUnique _patternOcounter _patternOimportEnvironment _patternOmonos _patternOnamesInScope _patternOparentTree _patternOpatternMatchWarnings) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3159 _assumptions' _expressionIassumptions + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3160 _locConstraints + _lhsOmonos :: Monos + _lhsOmonos = rule3161 _csetBinds _lhsImonos _patternIenvironment + _locConstraints = rule3162 _csetBinds _expressionIconstraints _lhsIconstraints _newcon _patternIconstraints + (_csetBinds,_assumptions') = rule3163 _cinfoBind _lhsIassumptions _patternIenvironment + _newcon = rule3164 _cinfoResult _expressionIbeta _patternIbeta + _cinfoResult = rule3165 _parentTree + _cinfoBind = rule3166 _parentTree _patternIenvironment + _localInfo = rule3167 _lhsImonos _self + _parentTree = rule3168 _expressionIinfoTree _lhsIparentTree _localInfo _patternIinfoTree + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3169 _parentTree + (_namesInScope,_unboundNames,_scopeInfo) = rule3170 _expressionIunboundNames _lhsInamesInScope _lhsIunboundNames _patternIpatVarNames + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3171 _namesInScope + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3172 _unboundNames + _expressionOnamesInScope = rule3173 _lhsInamesInScope + _expressionOtryPatterns = rule3174 () + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3175 _expressionIpatternMatchWarnings _lhsIimportEnvironment _lhsIsubstitution _patternIbeta _patternIelements _rangeIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3176 _expressionIcollectInstances + _self = rule3177 _expressionIself _patternIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule3178 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3179 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3180 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3181 _expressionIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule3182 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3183 _expressionIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3184 _expressionImatchIO + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3185 _expressionIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3186 _expressionIuniqueSecondRound + _patternObetaUnique = rule3187 _lhsIbetaUnique + _patternOcounter = rule3188 _lhsIcounter + _patternOimportEnvironment = rule3189 _lhsIimportEnvironment + _patternOmonos = rule3190 _lhsImonos + _patternOnamesInScope = rule3191 _namesInScope + _patternOparentTree = rule3192 _parentTree + _patternOpatternMatchWarnings = rule3193 _lhsIpatternMatchWarnings + _expressionOallPatterns = rule3194 _lhsIallPatterns + _expressionOallTypeSchemes = rule3195 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule3196 _lhsIavailablePredicates + _expressionObetaUnique = rule3197 _patternIbetaUnique + _expressionOclassEnvironment = rule3198 _lhsIclassEnvironment + _expressionOcollectErrors = rule3199 _lhsIcollectErrors + _expressionOcollectWarnings = rule3200 _lhsIcollectWarnings + _expressionOcounter = rule3201 _patternIcounter + _expressionOcurrentChunk = rule3202 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule3203 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule3204 _lhsIimportEnvironment + _expressionOmatchIO = rule3205 _lhsImatchIO + _expressionOmonos = rule3206 _lhsImonos + _expressionOorderedTypeSynonyms = rule3207 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule3208 _parentTree + _expressionOpatternMatchWarnings = rule3209 _patternIpatternMatchWarnings + _expressionOsubstitution = rule3210 _lhsIsubstitution + _expressionOtypeschemeMap = rule3211 _lhsItypeschemeMap + _expressionOuniqueChunk = rule3212 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule3213 _lhsIuniqueSecondRound + __result_ = T_Qualifier_vOut127 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule3159 #-} + rule3159 = \ _assumptions' ((_expressionIassumptions) :: Assumptions) -> + _assumptions' `combine` _expressionIassumptions + {-# INLINE rule3160 #-} + rule3160 = \ _locConstraints -> + _locConstraints + {-# INLINE rule3161 #-} + rule3161 = \ _csetBinds ((_lhsImonos) :: Monos) ((_patternIenvironment) :: PatternAssumptions) -> + M.elems _patternIenvironment ++ getMonos _csetBinds ++ _lhsImonos + {-# INLINE rule3162 #-} + rule3162 = \ _csetBinds ((_expressionIconstraints) :: ConstraintSet) ((_lhsIconstraints) :: ConstraintSet) _newcon ((_patternIconstraints) :: ConstraintSet) -> + _newcon .>. _csetBinds .>>. + Node [ _patternIconstraints + , _expressionIconstraints + , _lhsIconstraints + ] + {-# INLINE rule3163 #-} + rule3163 = \ _cinfoBind ((_lhsIassumptions) :: Assumptions) ((_patternIenvironment) :: PatternAssumptions) -> + (_patternIenvironment .===. _lhsIassumptions) _cinfoBind + {-# INLINE rule3164 #-} + rule3164 = \ _cinfoResult ((_expressionIbeta) :: Tp) ((_patternIbeta) :: Tp) -> + [ (_expressionIbeta .==. listType _patternIbeta) _cinfoResult ] + {-# INLINE rule3165 #-} + rule3165 = \ _parentTree -> + childConstraint 1 "generator" _parentTree + [] + {-# INLINE rule3166 #-} + rule3166 = \ _parentTree ((_patternIenvironment) :: PatternAssumptions) -> + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint + , makeUnifier name "generator" _patternIenvironment _parentTree + ] + {-# INLINE rule3167 #-} + rule3167 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Qual _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3168 #-} + rule3168 = \ ((_expressionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo ((_patternIinfoTree) :: InfoTree) -> + node _lhsIparentTree _localInfo [_patternIinfoTree, _expressionIinfoTree] + {-# INLINE rule3169 #-} + rule3169 = \ _parentTree -> + _parentTree + {-# INLINE rule3170 #-} + rule3170 = \ ((_expressionIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsIunboundNames) :: Names) ((_patternIpatVarNames) :: Names) -> + changeOfScope _patternIpatVarNames (_expressionIunboundNames ++ _lhsIunboundNames) _lhsInamesInScope + {-# INLINE rule3171 #-} + rule3171 = \ _namesInScope -> + _namesInScope + {-# INLINE rule3172 #-} + rule3172 = \ _unboundNames -> + _unboundNames + {-# INLINE rule3173 #-} + rule3173 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3174 #-} + rule3174 = \ (_ :: ()) -> + [] + {-# INLINE rule3175 #-} + rule3175 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) ((_lhsIimportEnvironment) :: ImportEnvironment) ((_lhsIsubstitution) :: FixpointSubstitution) ((_patternIbeta) :: Tp) ((_patternIelements) :: [PatternElement] ) ((_rangeIself) :: Range) -> + patternMatchWarnings _lhsIimportEnvironment + _lhsIsubstitution + _patternIbeta + (:[]) + [(_patternIelements, False)] + _rangeIself + Nothing + False + [] + "generator" + "<-" + ++ _expressionIpatternMatchWarnings + {-# INLINE rule3176 #-} + rule3176 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule3177 #-} + rule3177 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Qualifier_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule3178 #-} + rule3178 = \ _self -> + _self + {-# INLINE rule3179 #-} + rule3179 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule3180 #-} + rule3180 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule3181 #-} + rule3181 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule3182 #-} + rule3182 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule3183 #-} + rule3183 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule3184 #-} + rule3184 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule3185 #-} + rule3185 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule3186 #-} + rule3186 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule3187 #-} + rule3187 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3188 #-} + rule3188 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3189 #-} + rule3189 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3190 #-} + rule3190 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3191 #-} + rule3191 = \ _namesInScope -> + _namesInScope + {-# INLINE rule3192 #-} + rule3192 = \ _parentTree -> + _parentTree + {-# INLINE rule3193 #-} + rule3193 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3194 #-} + rule3194 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3195 #-} + rule3195 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule3196 #-} + rule3196 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3197 #-} + rule3197 = \ ((_patternIbetaUnique) :: Int) -> + _patternIbetaUnique + {-# INLINE rule3198 #-} + rule3198 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3199 #-} + rule3199 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3200 #-} + rule3200 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3201 #-} + rule3201 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule3202 #-} + rule3202 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3203 #-} + rule3203 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3204 #-} + rule3204 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3205 #-} + rule3205 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3206 #-} + rule3206 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3207 #-} + rule3207 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3208 #-} + rule3208 = \ _parentTree -> + _parentTree + {-# INLINE rule3209 #-} + rule3209 = \ ((_patternIpatternMatchWarnings) :: [Warning]) -> + _patternIpatternMatchWarnings + {-# INLINE rule3210 #-} + rule3210 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3211 #-} + rule3211 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3212 #-} + rule3212 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3213 #-} + rule3213 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Qualifier_Empty #-} +sem_Qualifier_Empty :: T_Range -> T_Qualifier +sem_Qualifier_Empty arg_range_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _localInfo = rule3214 _lhsImonos _self + _parentTree = rule3215 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3216 _parentTree + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3217 () + _self = rule3218 _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule3219 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3220 _lhsIassumptions + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3221 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3222 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3223 _lhsIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3224 _lhsIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule3225 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3226 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3227 _lhsImatchIO + _lhsOmonos :: Monos + _lhsOmonos = rule3228 _lhsImonos + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3229 _lhsInamesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3230 _lhsIpatternMatchWarnings + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3231 _lhsIunboundNames + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3232 _lhsIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3233 _lhsIuniqueSecondRound + __result_ = T_Qualifier_vOut127 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule3214 #-} + rule3214 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Qual _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3215 #-} + rule3215 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule3216 #-} + rule3216 = \ _parentTree -> + _parentTree + {-# INLINE rule3217 #-} + rule3217 = \ (_ :: ()) -> + [] + {-# INLINE rule3218 #-} + rule3218 = \ ((_rangeIself) :: Range) -> + Qualifier_Empty _rangeIself + {-# INLINE rule3219 #-} + rule3219 = \ _self -> + _self + {-# INLINE rule3220 #-} + rule3220 = \ ((_lhsIassumptions) :: Assumptions) -> + _lhsIassumptions + {-# INLINE rule3221 #-} + rule3221 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3222 #-} + rule3222 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3223 #-} + rule3223 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3224 #-} + rule3224 = \ ((_lhsIconstraints) :: ConstraintSet) -> + _lhsIconstraints + {-# INLINE rule3225 #-} + rule3225 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3226 #-} + rule3226 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3227 #-} + rule3227 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3228 #-} + rule3228 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3229 #-} + rule3229 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3230 #-} + rule3230 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3231 #-} + rule3231 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule3232 #-} + rule3232 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3233 #-} + rule3233 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + +-- Qualifiers -------------------------------------------------- +-- wrapper +data Inh_Qualifiers = Inh_Qualifiers { allPatterns_Inh_Qualifiers :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_Qualifiers :: (M.Map NameWithRange TpScheme), assumptions_Inh_Qualifiers :: (Assumptions), availablePredicates_Inh_Qualifiers :: (Predicates), betaUnique_Inh_Qualifiers :: (Int), classEnvironment_Inh_Qualifiers :: (ClassEnvironment), collectErrors_Inh_Qualifiers :: (TypeErrors), collectWarnings_Inh_Qualifiers :: (Warnings), constraints_Inh_Qualifiers :: (ConstraintSet), counter_Inh_Qualifiers :: (Int), currentChunk_Inh_Qualifiers :: (Int), dictionaryEnvironment_Inh_Qualifiers :: (DictionaryEnvironment), importEnvironment_Inh_Qualifiers :: (ImportEnvironment), matchIO_Inh_Qualifiers :: (IO ()), monos_Inh_Qualifiers :: (Monos), namesInScope_Inh_Qualifiers :: (Names), orderedTypeSynonyms_Inh_Qualifiers :: (OrderedTypeSynonyms), parentTree_Inh_Qualifiers :: (InfoTree), patternMatchWarnings_Inh_Qualifiers :: ([Warning]), substitution_Inh_Qualifiers :: (FixpointSubstitution), typeschemeMap_Inh_Qualifiers :: (M.Map Int (Scheme Predicates)), unboundNames_Inh_Qualifiers :: (Names), uniqueChunk_Inh_Qualifiers :: (Int), uniqueSecondRound_Inh_Qualifiers :: (Int) } +data Syn_Qualifiers = Syn_Qualifiers { assumptions_Syn_Qualifiers :: (Assumptions), betaUnique_Syn_Qualifiers :: (Int), collectErrors_Syn_Qualifiers :: (TypeErrors), collectInstances_Syn_Qualifiers :: ([(Name, Instance)]), collectWarnings_Syn_Qualifiers :: (Warnings), constraints_Syn_Qualifiers :: (ConstraintSet), counter_Syn_Qualifiers :: (Int), dictionaryEnvironment_Syn_Qualifiers :: (DictionaryEnvironment), infoTrees_Syn_Qualifiers :: (InfoTrees), matchIO_Syn_Qualifiers :: (IO ()), monos_Syn_Qualifiers :: (Monos), namesInScope_Syn_Qualifiers :: (Names), patternMatchWarnings_Syn_Qualifiers :: ([Warning]), self_Syn_Qualifiers :: (Qualifiers), unboundNames_Syn_Qualifiers :: (Names), uniqueChunk_Syn_Qualifiers :: (Int), uniqueSecondRound_Syn_Qualifiers :: (Int) } +{-# INLINABLE wrap_Qualifiers #-} +wrap_Qualifiers :: T_Qualifiers -> Inh_Qualifiers -> (Syn_Qualifiers ) +wrap_Qualifiers (T_Qualifiers act) (Inh_Qualifiers _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifiers_vIn130 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound + (T_Qualifiers_vOut130 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) <- return (inv_Qualifiers_s131 sem arg) + return (Syn_Qualifiers _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) + ) + +-- cata +{-# NOINLINE sem_Qualifiers #-} +sem_Qualifiers :: Qualifiers -> T_Qualifiers +sem_Qualifiers list = Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list) + +-- semantic domain +newtype T_Qualifiers = T_Qualifiers { + attach_T_Qualifiers :: Identity (T_Qualifiers_s131 ) + } +newtype T_Qualifiers_s131 = C_Qualifiers_s131 { + inv_Qualifiers_s131 :: (T_Qualifiers_v130 ) + } +data T_Qualifiers_s132 = C_Qualifiers_s132 +type T_Qualifiers_v130 = (T_Qualifiers_vIn130 ) -> (T_Qualifiers_vOut130 ) +data T_Qualifiers_vIn130 = T_Qualifiers_vIn130 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Assumptions) (Predicates) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (ConstraintSet) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Names) (Int) (Int) +data T_Qualifiers_vOut130 = T_Qualifiers_vOut130 (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (DictionaryEnvironment) (InfoTrees) (IO ()) (Monos) (Names) ([Warning]) (Qualifiers) (Names) (Int) (Int) +{-# NOINLINE sem_Qualifiers_Cons #-} +sem_Qualifiers_Cons :: T_Qualifier -> T_Qualifiers -> T_Qualifiers +sem_Qualifiers_Cons arg_hd_ arg_tl_ = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _hdX128 = Control.Monad.Identity.runIdentity (attach_T_Qualifier (arg_hd_)) + _tlX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_tl_)) + (T_Qualifier_vOut127 _hdIassumptions _hdIbetaUnique _hdIcollectErrors _hdIcollectInstances _hdIcollectWarnings _hdIconstraints _hdIcounter _hdIdictionaryEnvironment _hdIinfoTree _hdImatchIO _hdImonos _hdInamesInScope _hdIpatternMatchWarnings _hdIself _hdIunboundNames _hdIuniqueChunk _hdIuniqueSecondRound) = inv_Qualifier_s128 _hdX128 (T_Qualifier_vIn127 _hdOallPatterns _hdOallTypeSchemes _hdOassumptions _hdOavailablePredicates _hdObetaUnique _hdOclassEnvironment _hdOcollectErrors _hdOcollectWarnings _hdOconstraints _hdOcounter _hdOcurrentChunk _hdOdictionaryEnvironment _hdOimportEnvironment _hdOmatchIO _hdOmonos _hdOnamesInScope _hdOorderedTypeSynonyms _hdOparentTree _hdOpatternMatchWarnings _hdOsubstitution _hdOtypeschemeMap _hdOunboundNames _hdOuniqueChunk _hdOuniqueSecondRound) + (T_Qualifiers_vOut130 _tlIassumptions _tlIbetaUnique _tlIcollectErrors _tlIcollectInstances _tlIcollectWarnings _tlIconstraints _tlIcounter _tlIdictionaryEnvironment _tlIinfoTrees _tlImatchIO _tlImonos _tlInamesInScope _tlIpatternMatchWarnings _tlIself _tlIunboundNames _tlIuniqueChunk _tlIuniqueSecondRound) = inv_Qualifiers_s131 _tlX131 (T_Qualifiers_vIn130 _tlOallPatterns _tlOallTypeSchemes _tlOassumptions _tlOavailablePredicates _tlObetaUnique _tlOclassEnvironment _tlOcollectErrors _tlOcollectWarnings _tlOconstraints _tlOcounter _tlOcurrentChunk _tlOdictionaryEnvironment _tlOimportEnvironment _tlOmatchIO _tlOmonos _tlOnamesInScope _tlOorderedTypeSynonyms _tlOparentTree _tlOpatternMatchWarnings _tlOsubstitution _tlOtypeschemeMap _tlOunboundNames _tlOuniqueChunk _tlOuniqueSecondRound) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3234 _hdIassumptions + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3235 _hdIconstraints + _hdOassumptions = rule3236 _tlIassumptions + _hdOconstraints = rule3237 _tlIconstraints + _tlOassumptions = rule3238 _lhsIassumptions + _tlOconstraints = rule3239 _lhsIconstraints + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule3240 _hdIinfoTree _tlIinfoTrees + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3241 _hdIunboundNames + _tlOunboundNames = rule3242 _lhsIunboundNames + _hdOunboundNames = rule3243 _tlIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3244 _hdIcollectInstances _tlIcollectInstances + _self = rule3245 _hdIself _tlIself + _lhsOself :: Qualifiers + _lhsOself = rule3246 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3247 _tlIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3248 _tlIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3249 _tlIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule3250 _tlIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3251 _tlIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3252 _tlImatchIO + _lhsOmonos :: Monos + _lhsOmonos = rule3253 _tlImonos + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3254 _tlInamesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3255 _tlIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3256 _tlIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3257 _tlIuniqueSecondRound + _hdOallPatterns = rule3258 _lhsIallPatterns + _hdOallTypeSchemes = rule3259 _lhsIallTypeSchemes + _hdOavailablePredicates = rule3260 _lhsIavailablePredicates + _hdObetaUnique = rule3261 _lhsIbetaUnique + _hdOclassEnvironment = rule3262 _lhsIclassEnvironment + _hdOcollectErrors = rule3263 _lhsIcollectErrors + _hdOcollectWarnings = rule3264 _lhsIcollectWarnings + _hdOcounter = rule3265 _lhsIcounter + _hdOcurrentChunk = rule3266 _lhsIcurrentChunk + _hdOdictionaryEnvironment = rule3267 _lhsIdictionaryEnvironment + _hdOimportEnvironment = rule3268 _lhsIimportEnvironment + _hdOmatchIO = rule3269 _lhsImatchIO + _hdOmonos = rule3270 _lhsImonos + _hdOnamesInScope = rule3271 _lhsInamesInScope + _hdOorderedTypeSynonyms = rule3272 _lhsIorderedTypeSynonyms + _hdOparentTree = rule3273 _lhsIparentTree + _hdOpatternMatchWarnings = rule3274 _lhsIpatternMatchWarnings + _hdOsubstitution = rule3275 _lhsIsubstitution + _hdOtypeschemeMap = rule3276 _lhsItypeschemeMap + _hdOuniqueChunk = rule3277 _lhsIuniqueChunk + _hdOuniqueSecondRound = rule3278 _lhsIuniqueSecondRound + _tlOallPatterns = rule3279 _lhsIallPatterns + _tlOallTypeSchemes = rule3280 _lhsIallTypeSchemes + _tlOavailablePredicates = rule3281 _lhsIavailablePredicates + _tlObetaUnique = rule3282 _hdIbetaUnique + _tlOclassEnvironment = rule3283 _lhsIclassEnvironment + _tlOcollectErrors = rule3284 _hdIcollectErrors + _tlOcollectWarnings = rule3285 _hdIcollectWarnings + _tlOcounter = rule3286 _hdIcounter + _tlOcurrentChunk = rule3287 _lhsIcurrentChunk + _tlOdictionaryEnvironment = rule3288 _hdIdictionaryEnvironment + _tlOimportEnvironment = rule3289 _lhsIimportEnvironment + _tlOmatchIO = rule3290 _hdImatchIO + _tlOmonos = rule3291 _hdImonos + _tlOnamesInScope = rule3292 _hdInamesInScope + _tlOorderedTypeSynonyms = rule3293 _lhsIorderedTypeSynonyms + _tlOparentTree = rule3294 _lhsIparentTree + _tlOpatternMatchWarnings = rule3295 _hdIpatternMatchWarnings + _tlOsubstitution = rule3296 _lhsIsubstitution + _tlOtypeschemeMap = rule3297 _lhsItypeschemeMap + _tlOuniqueChunk = rule3298 _hdIuniqueChunk + _tlOuniqueSecondRound = rule3299 _hdIuniqueSecondRound + __result_ = T_Qualifiers_vOut130 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule3234 #-} + rule3234 = \ ((_hdIassumptions) :: Assumptions) -> + _hdIassumptions + {-# INLINE rule3235 #-} + rule3235 = \ ((_hdIconstraints) :: ConstraintSet) -> + _hdIconstraints + {-# INLINE rule3236 #-} + rule3236 = \ ((_tlIassumptions) :: Assumptions) -> + _tlIassumptions + {-# INLINE rule3237 #-} + rule3237 = \ ((_tlIconstraints) :: ConstraintSet) -> + _tlIconstraints + {-# INLINE rule3238 #-} + rule3238 = \ ((_lhsIassumptions) :: Assumptions) -> + _lhsIassumptions + {-# INLINE rule3239 #-} + rule3239 = \ ((_lhsIconstraints) :: ConstraintSet) -> + _lhsIconstraints + {-# INLINE rule3240 #-} + rule3240 = \ ((_hdIinfoTree) :: InfoTree) ((_tlIinfoTrees) :: InfoTrees) -> + _hdIinfoTree : _tlIinfoTrees + {-# INLINE rule3241 #-} + rule3241 = \ ((_hdIunboundNames) :: Names) -> + _hdIunboundNames + {-# INLINE rule3242 #-} + rule3242 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule3243 #-} + rule3243 = \ ((_tlIunboundNames) :: Names) -> + _tlIunboundNames + {-# INLINE rule3244 #-} + rule3244 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule3245 #-} + rule3245 = \ ((_hdIself) :: Qualifier) ((_tlIself) :: Qualifiers) -> + (:) _hdIself _tlIself + {-# INLINE rule3246 #-} + rule3246 = \ _self -> + _self + {-# INLINE rule3247 #-} + rule3247 = \ ((_tlIbetaUnique) :: Int) -> + _tlIbetaUnique + {-# INLINE rule3248 #-} + rule3248 = \ ((_tlIcollectErrors) :: TypeErrors) -> + _tlIcollectErrors + {-# INLINE rule3249 #-} + rule3249 = \ ((_tlIcollectWarnings) :: Warnings) -> + _tlIcollectWarnings + {-# INLINE rule3250 #-} + rule3250 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule3251 #-} + rule3251 = \ ((_tlIdictionaryEnvironment) :: DictionaryEnvironment) -> + _tlIdictionaryEnvironment + {-# INLINE rule3252 #-} + rule3252 = \ ((_tlImatchIO) :: IO ()) -> + _tlImatchIO + {-# INLINE rule3253 #-} + rule3253 = \ ((_tlImonos) :: Monos) -> + _tlImonos + {-# INLINE rule3254 #-} + rule3254 = \ ((_tlInamesInScope) :: Names) -> + _tlInamesInScope + {-# INLINE rule3255 #-} + rule3255 = \ ((_tlIpatternMatchWarnings) :: [Warning]) -> + _tlIpatternMatchWarnings + {-# INLINE rule3256 #-} + rule3256 = \ ((_tlIuniqueChunk) :: Int) -> + _tlIuniqueChunk + {-# INLINE rule3257 #-} + rule3257 = \ ((_tlIuniqueSecondRound) :: Int) -> + _tlIuniqueSecondRound + {-# INLINE rule3258 #-} + rule3258 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3259 #-} + rule3259 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule3260 #-} + rule3260 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3261 #-} + rule3261 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3262 #-} + rule3262 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3263 #-} + rule3263 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3264 #-} + rule3264 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3265 #-} + rule3265 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3266 #-} + rule3266 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3267 #-} + rule3267 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3268 #-} + rule3268 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3269 #-} + rule3269 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3270 #-} + rule3270 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3271 #-} + rule3271 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3272 #-} + rule3272 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3273 #-} + rule3273 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule3274 #-} + rule3274 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3275 #-} + rule3275 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3276 #-} + rule3276 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3277 #-} + rule3277 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3278 #-} + rule3278 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule3279 #-} + rule3279 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3280 #-} + rule3280 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule3281 #-} + rule3281 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3282 #-} + rule3282 = \ ((_hdIbetaUnique) :: Int) -> + _hdIbetaUnique + {-# INLINE rule3283 #-} + rule3283 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3284 #-} + rule3284 = \ ((_hdIcollectErrors) :: TypeErrors) -> + _hdIcollectErrors + {-# INLINE rule3285 #-} + rule3285 = \ ((_hdIcollectWarnings) :: Warnings) -> + _hdIcollectWarnings + {-# INLINE rule3286 #-} + rule3286 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule3287 #-} + rule3287 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3288 #-} + rule3288 = \ ((_hdIdictionaryEnvironment) :: DictionaryEnvironment) -> + _hdIdictionaryEnvironment + {-# INLINE rule3289 #-} + rule3289 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3290 #-} + rule3290 = \ ((_hdImatchIO) :: IO ()) -> + _hdImatchIO + {-# INLINE rule3291 #-} + rule3291 = \ ((_hdImonos) :: Monos) -> + _hdImonos + {-# INLINE rule3292 #-} + rule3292 = \ ((_hdInamesInScope) :: Names) -> + _hdInamesInScope + {-# INLINE rule3293 #-} + rule3293 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3294 #-} + rule3294 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule3295 #-} + rule3295 = \ ((_hdIpatternMatchWarnings) :: [Warning]) -> + _hdIpatternMatchWarnings + {-# INLINE rule3296 #-} + rule3296 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3297 #-} + rule3297 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3298 #-} + rule3298 = \ ((_hdIuniqueChunk) :: Int) -> + _hdIuniqueChunk + {-# INLINE rule3299 #-} + rule3299 = \ ((_hdIuniqueSecondRound) :: Int) -> + _hdIuniqueSecondRound +{-# NOINLINE sem_Qualifiers_Nil #-} +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule3300 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3301 _lhsIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3302 () + _self = rule3303 () + _lhsOself :: Qualifiers + _lhsOself = rule3304 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3305 _lhsIassumptions + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3306 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3307 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3308 _lhsIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3309 _lhsIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule3310 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3311 _lhsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3312 _lhsImatchIO + _lhsOmonos :: Monos + _lhsOmonos = rule3313 _lhsImonos + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3314 _lhsInamesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3315 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3316 _lhsIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3317 _lhsIuniqueSecondRound + __result_ = T_Qualifiers_vOut130 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOinfoTrees _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule3300 #-} + rule3300 = \ (_ :: ()) -> + [] + {-# INLINE rule3301 #-} + rule3301 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule3302 #-} + rule3302 = \ (_ :: ()) -> + [] + {-# INLINE rule3303 #-} + rule3303 = \ (_ :: ()) -> + [] + {-# INLINE rule3304 #-} + rule3304 = \ _self -> + _self + {-# INLINE rule3305 #-} + rule3305 = \ ((_lhsIassumptions) :: Assumptions) -> + _lhsIassumptions + {-# INLINE rule3306 #-} + rule3306 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3307 #-} + rule3307 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3308 #-} + rule3308 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3309 #-} + rule3309 = \ ((_lhsIconstraints) :: ConstraintSet) -> + _lhsIconstraints + {-# INLINE rule3310 #-} + rule3310 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3311 #-} + rule3311 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3312 #-} + rule3312 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3313 #-} + rule3313 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3314 #-} + rule3314 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3315 #-} + rule3315 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3316 #-} + rule3316 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3317 #-} + rule3317 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + +-- Range ------------------------------------------------------- +-- wrapper +data Inh_Range = Inh_Range { } +data Syn_Range = Syn_Range { self_Syn_Range :: (Range) } +{-# INLINABLE wrap_Range #-} +wrap_Range :: T_Range -> Inh_Range -> (Syn_Range ) +wrap_Range (T_Range act) (Inh_Range ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Range_vIn133 + (T_Range_vOut133 _lhsOself) <- return (inv_Range_s134 sem arg) + return (Syn_Range _lhsOself) + ) + +-- cata +{-# INLINE sem_Range #-} +sem_Range :: Range -> T_Range +sem_Range ( Range_Range start_ stop_ ) = sem_Range_Range ( sem_Position start_ ) ( sem_Position stop_ ) + +-- semantic domain +newtype T_Range = T_Range { + attach_T_Range :: Identity (T_Range_s134 ) + } +newtype T_Range_s134 = C_Range_s134 { + inv_Range_s134 :: (T_Range_v133 ) + } +data T_Range_s135 = C_Range_s135 +type T_Range_v133 = (T_Range_vIn133 ) -> (T_Range_vOut133 ) +data T_Range_vIn133 = T_Range_vIn133 +data T_Range_vOut133 = T_Range_vOut133 (Range) +{-# NOINLINE sem_Range_Range #-} +sem_Range_Range :: T_Position -> T_Position -> T_Range +sem_Range_Range arg_start_ arg_stop_ = T_Range (return st134) where + {-# NOINLINE st134 #-} + st134 = let + v133 :: T_Range_v133 + v133 = \ (T_Range_vIn133 ) -> ( let + _startX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_start_)) + _stopX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_stop_)) + (T_Position_vOut124 _startIself) = inv_Position_s125 _startX125 (T_Position_vIn124 ) + (T_Position_vOut124 _stopIself) = inv_Position_s125 _stopX125 (T_Position_vIn124 ) + _self = rule3318 _startIself _stopIself + _lhsOself :: Range + _lhsOself = rule3319 _self + __result_ = T_Range_vOut133 _lhsOself + in __result_ ) + in C_Range_s134 v133 + {-# INLINE rule3318 #-} + rule3318 = \ ((_startIself) :: Position) ((_stopIself) :: Position) -> + Range_Range _startIself _stopIself + {-# INLINE rule3319 #-} + rule3319 = \ _self -> + _self + +-- RecordExpressionBinding ------------------------------------- +-- wrapper +data Inh_RecordExpressionBinding = Inh_RecordExpressionBinding { allTypeSchemes_Inh_RecordExpressionBinding :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_RecordExpressionBinding :: (Predicates), classEnvironment_Inh_RecordExpressionBinding :: (ClassEnvironment), collectErrors_Inh_RecordExpressionBinding :: (TypeErrors), collectWarnings_Inh_RecordExpressionBinding :: (Warnings), counter_Inh_RecordExpressionBinding :: (Int), currentChunk_Inh_RecordExpressionBinding :: (Int), dictionaryEnvironment_Inh_RecordExpressionBinding :: (DictionaryEnvironment), importEnvironment_Inh_RecordExpressionBinding :: (ImportEnvironment), namesInScope_Inh_RecordExpressionBinding :: (Names), orderedTypeSynonyms_Inh_RecordExpressionBinding :: (OrderedTypeSynonyms), patternMatchWarnings_Inh_RecordExpressionBinding :: ([Warning]), substitution_Inh_RecordExpressionBinding :: (FixpointSubstitution), typeschemeMap_Inh_RecordExpressionBinding :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_RecordExpressionBinding :: (Int) } +data Syn_RecordExpressionBinding = Syn_RecordExpressionBinding { collectErrors_Syn_RecordExpressionBinding :: (TypeErrors), collectInstances_Syn_RecordExpressionBinding :: ([(Name, Instance)]), collectWarnings_Syn_RecordExpressionBinding :: (Warnings), counter_Syn_RecordExpressionBinding :: (Int), dictionaryEnvironment_Syn_RecordExpressionBinding :: (DictionaryEnvironment), patternMatchWarnings_Syn_RecordExpressionBinding :: ([Warning]), self_Syn_RecordExpressionBinding :: (RecordExpressionBinding), unboundNames_Syn_RecordExpressionBinding :: (Names), uniqueChunk_Syn_RecordExpressionBinding :: (Int) } +{-# INLINABLE wrap_RecordExpressionBinding #-} +wrap_RecordExpressionBinding :: T_RecordExpressionBinding -> Inh_RecordExpressionBinding -> (Syn_RecordExpressionBinding ) +wrap_RecordExpressionBinding (T_RecordExpressionBinding act) (Inh_RecordExpressionBinding _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBinding_vIn136 _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk + (T_RecordExpressionBinding_vOut136 _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdictionaryEnvironment _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk) <- return (inv_RecordExpressionBinding_s137 sem arg) + return (Syn_RecordExpressionBinding _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdictionaryEnvironment _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBinding #-} +sem_RecordExpressionBinding :: RecordExpressionBinding -> T_RecordExpressionBinding +sem_RecordExpressionBinding ( RecordExpressionBinding_RecordExpressionBinding range_ name_ expression_ ) = sem_RecordExpressionBinding_RecordExpressionBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_RecordExpressionBinding = T_RecordExpressionBinding { + attach_T_RecordExpressionBinding :: Identity (T_RecordExpressionBinding_s137 ) + } +newtype T_RecordExpressionBinding_s137 = C_RecordExpressionBinding_s137 { + inv_RecordExpressionBinding_s137 :: (T_RecordExpressionBinding_v136 ) + } +data T_RecordExpressionBinding_s138 = C_RecordExpressionBinding_s138 +type T_RecordExpressionBinding_v136 = (T_RecordExpressionBinding_vIn136 ) -> (T_RecordExpressionBinding_vOut136 ) +data T_RecordExpressionBinding_vIn136 = T_RecordExpressionBinding_vIn136 (M.Map NameWithRange TpScheme) (Predicates) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (Names) (OrderedTypeSynonyms) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Int) +data T_RecordExpressionBinding_vOut136 = T_RecordExpressionBinding_vOut136 (TypeErrors) ([(Name, Instance)]) (Warnings) (Int) (DictionaryEnvironment) ([Warning]) (RecordExpressionBinding) (Names) (Int) +{-# NOINLINE sem_RecordExpressionBinding_RecordExpressionBinding #-} +sem_RecordExpressionBinding_RecordExpressionBinding :: T_Range -> T_Name -> T_Expression -> T_RecordExpressionBinding +sem_RecordExpressionBinding_RecordExpressionBinding arg_range_ arg_name_ arg_expression_ = T_RecordExpressionBinding (return st137) where + {-# NOINLINE st137 #-} + st137 = let + v136 :: T_RecordExpressionBinding_v136 + v136 = \ (T_RecordExpressionBinding_vIn136 _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _parentTree = rule3320 () + (_monos,_constructorenv,_betaUnique,_miscerrors,_warnings,_kindErrors,_valueConstructors,_allValueConstructors,_typeConstructors,_allTypeConstructors,_importEnvironment) = rule3321 () + (_allPatterns,_tryPatterns,_matchIO,_uniqueSecondRound) = rule3322 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3323 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3324 _expressionIunboundNames + _self = rule3325 _expressionIself _nameIself _rangeIself + _lhsOself :: RecordExpressionBinding + _lhsOself = rule3326 _self + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3327 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3328 _expressionIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule3329 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3330 _expressionIdictionaryEnvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3331 _expressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3332 _expressionIuniqueChunk + _expressionOallPatterns = rule3333 _allPatterns + _expressionOallTypeSchemes = rule3334 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule3335 _lhsIavailablePredicates + _expressionObetaUnique = rule3336 _betaUnique + _expressionOclassEnvironment = rule3337 _lhsIclassEnvironment + _expressionOcollectErrors = rule3338 _lhsIcollectErrors + _expressionOcollectWarnings = rule3339 _lhsIcollectWarnings + _expressionOcounter = rule3340 _lhsIcounter + _expressionOcurrentChunk = rule3341 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule3342 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule3343 _importEnvironment + _expressionOmatchIO = rule3344 _matchIO + _expressionOmonos = rule3345 _monos + _expressionOnamesInScope = rule3346 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule3347 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule3348 _parentTree + _expressionOpatternMatchWarnings = rule3349 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule3350 _lhsIsubstitution + _expressionOtryPatterns = rule3351 _tryPatterns + _expressionOtypeschemeMap = rule3352 _lhsItypeschemeMap + _expressionOuniqueChunk = rule3353 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule3354 _uniqueSecondRound + __result_ = T_RecordExpressionBinding_vOut136 _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdictionaryEnvironment _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_RecordExpressionBinding_s137 v136 + {-# INLINE rule3320 #-} + rule3320 = \ (_ :: ()) -> + globalInfoError + {-# INLINE rule3321 #-} + rule3321 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "RecordExpressionBinding.RecordExpressionBinding" + {-# INLINE rule3322 #-} + rule3322 = \ (_ :: ()) -> + internalError "TS_PatternMatching.ag" "n/a" "RecordExpressionBinding is not supported" + {-# INLINE rule3323 #-} + rule3323 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule3324 #-} + rule3324 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule3325 #-} + rule3325 = \ ((_expressionIself) :: Expression) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + RecordExpressionBinding_RecordExpressionBinding _rangeIself _nameIself _expressionIself + {-# INLINE rule3326 #-} + rule3326 = \ _self -> + _self + {-# INLINE rule3327 #-} + rule3327 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule3328 #-} + rule3328 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule3329 #-} + rule3329 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule3330 #-} + rule3330 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule3331 #-} + rule3331 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule3332 #-} + rule3332 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule3333 #-} + rule3333 = \ _allPatterns -> + _allPatterns + {-# INLINE rule3334 #-} + rule3334 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule3335 #-} + rule3335 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3336 #-} + rule3336 = \ _betaUnique -> + _betaUnique + {-# INLINE rule3337 #-} + rule3337 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3338 #-} + rule3338 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3339 #-} + rule3339 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3340 #-} + rule3340 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3341 #-} + rule3341 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3342 #-} + rule3342 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3343 #-} + rule3343 = \ _importEnvironment -> + _importEnvironment + {-# INLINE rule3344 #-} + rule3344 = \ _matchIO -> + _matchIO + {-# INLINE rule3345 #-} + rule3345 = \ _monos -> + _monos + {-# INLINE rule3346 #-} + rule3346 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3347 #-} + rule3347 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3348 #-} + rule3348 = \ _parentTree -> + _parentTree + {-# INLINE rule3349 #-} + rule3349 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3350 #-} + rule3350 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3351 #-} + rule3351 = \ _tryPatterns -> + _tryPatterns + {-# INLINE rule3352 #-} + rule3352 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3353 #-} + rule3353 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3354 #-} + rule3354 = \ _uniqueSecondRound -> + _uniqueSecondRound + +-- RecordExpressionBindings ------------------------------------ +-- wrapper +data Inh_RecordExpressionBindings = Inh_RecordExpressionBindings { allTypeSchemes_Inh_RecordExpressionBindings :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_RecordExpressionBindings :: (Predicates), classEnvironment_Inh_RecordExpressionBindings :: (ClassEnvironment), collectErrors_Inh_RecordExpressionBindings :: (TypeErrors), collectWarnings_Inh_RecordExpressionBindings :: (Warnings), counter_Inh_RecordExpressionBindings :: (Int), currentChunk_Inh_RecordExpressionBindings :: (Int), dictionaryEnvironment_Inh_RecordExpressionBindings :: (DictionaryEnvironment), importEnvironment_Inh_RecordExpressionBindings :: (ImportEnvironment), namesInScope_Inh_RecordExpressionBindings :: (Names), orderedTypeSynonyms_Inh_RecordExpressionBindings :: (OrderedTypeSynonyms), patternMatchWarnings_Inh_RecordExpressionBindings :: ([Warning]), substitution_Inh_RecordExpressionBindings :: (FixpointSubstitution), typeschemeMap_Inh_RecordExpressionBindings :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_RecordExpressionBindings :: (Int) } +data Syn_RecordExpressionBindings = Syn_RecordExpressionBindings { collectErrors_Syn_RecordExpressionBindings :: (TypeErrors), collectInstances_Syn_RecordExpressionBindings :: ([(Name, Instance)]), collectWarnings_Syn_RecordExpressionBindings :: (Warnings), counter_Syn_RecordExpressionBindings :: (Int), dictionaryEnvironment_Syn_RecordExpressionBindings :: (DictionaryEnvironment), patternMatchWarnings_Syn_RecordExpressionBindings :: ([Warning]), self_Syn_RecordExpressionBindings :: (RecordExpressionBindings), unboundNames_Syn_RecordExpressionBindings :: (Names), uniqueChunk_Syn_RecordExpressionBindings :: (Int) } +{-# INLINABLE wrap_RecordExpressionBindings #-} +wrap_RecordExpressionBindings :: T_RecordExpressionBindings -> Inh_RecordExpressionBindings -> (Syn_RecordExpressionBindings ) +wrap_RecordExpressionBindings (T_RecordExpressionBindings act) (Inh_RecordExpressionBindings _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBindings_vIn139 _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk + (T_RecordExpressionBindings_vOut139 _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdictionaryEnvironment _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk) <- return (inv_RecordExpressionBindings_s140 sem arg) + return (Syn_RecordExpressionBindings _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdictionaryEnvironment _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBindings #-} +sem_RecordExpressionBindings :: RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings list = Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list) + +-- semantic domain +newtype T_RecordExpressionBindings = T_RecordExpressionBindings { + attach_T_RecordExpressionBindings :: Identity (T_RecordExpressionBindings_s140 ) + } +newtype T_RecordExpressionBindings_s140 = C_RecordExpressionBindings_s140 { + inv_RecordExpressionBindings_s140 :: (T_RecordExpressionBindings_v139 ) + } +data T_RecordExpressionBindings_s141 = C_RecordExpressionBindings_s141 +type T_RecordExpressionBindings_v139 = (T_RecordExpressionBindings_vIn139 ) -> (T_RecordExpressionBindings_vOut139 ) +data T_RecordExpressionBindings_vIn139 = T_RecordExpressionBindings_vIn139 (M.Map NameWithRange TpScheme) (Predicates) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (Names) (OrderedTypeSynonyms) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Int) +data T_RecordExpressionBindings_vOut139 = T_RecordExpressionBindings_vOut139 (TypeErrors) ([(Name, Instance)]) (Warnings) (Int) (DictionaryEnvironment) ([Warning]) (RecordExpressionBindings) (Names) (Int) +{-# NOINLINE sem_RecordExpressionBindings_Cons #-} +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> T_RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons arg_hd_ arg_tl_ = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _hdX137 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBinding (arg_hd_)) + _tlX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_tl_)) + (T_RecordExpressionBinding_vOut136 _hdIcollectErrors _hdIcollectInstances _hdIcollectWarnings _hdIcounter _hdIdictionaryEnvironment _hdIpatternMatchWarnings _hdIself _hdIunboundNames _hdIuniqueChunk) = inv_RecordExpressionBinding_s137 _hdX137 (T_RecordExpressionBinding_vIn136 _hdOallTypeSchemes _hdOavailablePredicates _hdOclassEnvironment _hdOcollectErrors _hdOcollectWarnings _hdOcounter _hdOcurrentChunk _hdOdictionaryEnvironment _hdOimportEnvironment _hdOnamesInScope _hdOorderedTypeSynonyms _hdOpatternMatchWarnings _hdOsubstitution _hdOtypeschemeMap _hdOuniqueChunk) + (T_RecordExpressionBindings_vOut139 _tlIcollectErrors _tlIcollectInstances _tlIcollectWarnings _tlIcounter _tlIdictionaryEnvironment _tlIpatternMatchWarnings _tlIself _tlIunboundNames _tlIuniqueChunk) = inv_RecordExpressionBindings_s140 _tlX140 (T_RecordExpressionBindings_vIn139 _tlOallTypeSchemes _tlOavailablePredicates _tlOclassEnvironment _tlOcollectErrors _tlOcollectWarnings _tlOcounter _tlOcurrentChunk _tlOdictionaryEnvironment _tlOimportEnvironment _tlOnamesInScope _tlOorderedTypeSynonyms _tlOpatternMatchWarnings _tlOsubstitution _tlOtypeschemeMap _tlOuniqueChunk) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3355 _hdIcollectInstances _tlIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3356 _hdIunboundNames _tlIunboundNames + _self = rule3357 _hdIself _tlIself + _lhsOself :: RecordExpressionBindings + _lhsOself = rule3358 _self + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3359 _tlIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3360 _tlIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule3361 _tlIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3362 _tlIdictionaryEnvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3363 _tlIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3364 _tlIuniqueChunk + _hdOallTypeSchemes = rule3365 _lhsIallTypeSchemes + _hdOavailablePredicates = rule3366 _lhsIavailablePredicates + _hdOclassEnvironment = rule3367 _lhsIclassEnvironment + _hdOcollectErrors = rule3368 _lhsIcollectErrors + _hdOcollectWarnings = rule3369 _lhsIcollectWarnings + _hdOcounter = rule3370 _lhsIcounter + _hdOcurrentChunk = rule3371 _lhsIcurrentChunk + _hdOdictionaryEnvironment = rule3372 _lhsIdictionaryEnvironment + _hdOimportEnvironment = rule3373 _lhsIimportEnvironment + _hdOnamesInScope = rule3374 _lhsInamesInScope + _hdOorderedTypeSynonyms = rule3375 _lhsIorderedTypeSynonyms + _hdOpatternMatchWarnings = rule3376 _lhsIpatternMatchWarnings + _hdOsubstitution = rule3377 _lhsIsubstitution + _hdOtypeschemeMap = rule3378 _lhsItypeschemeMap + _hdOuniqueChunk = rule3379 _lhsIuniqueChunk + _tlOallTypeSchemes = rule3380 _lhsIallTypeSchemes + _tlOavailablePredicates = rule3381 _lhsIavailablePredicates + _tlOclassEnvironment = rule3382 _lhsIclassEnvironment + _tlOcollectErrors = rule3383 _hdIcollectErrors + _tlOcollectWarnings = rule3384 _hdIcollectWarnings + _tlOcounter = rule3385 _hdIcounter + _tlOcurrentChunk = rule3386 _lhsIcurrentChunk + _tlOdictionaryEnvironment = rule3387 _hdIdictionaryEnvironment + _tlOimportEnvironment = rule3388 _lhsIimportEnvironment + _tlOnamesInScope = rule3389 _lhsInamesInScope + _tlOorderedTypeSynonyms = rule3390 _lhsIorderedTypeSynonyms + _tlOpatternMatchWarnings = rule3391 _hdIpatternMatchWarnings + _tlOsubstitution = rule3392 _lhsIsubstitution + _tlOtypeschemeMap = rule3393 _lhsItypeschemeMap + _tlOuniqueChunk = rule3394 _hdIuniqueChunk + __result_ = T_RecordExpressionBindings_vOut139 _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdictionaryEnvironment _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule3355 #-} + rule3355 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule3356 #-} + rule3356 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule3357 #-} + rule3357 = \ ((_hdIself) :: RecordExpressionBinding) ((_tlIself) :: RecordExpressionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule3358 #-} + rule3358 = \ _self -> + _self + {-# INLINE rule3359 #-} + rule3359 = \ ((_tlIcollectErrors) :: TypeErrors) -> + _tlIcollectErrors + {-# INLINE rule3360 #-} + rule3360 = \ ((_tlIcollectWarnings) :: Warnings) -> + _tlIcollectWarnings + {-# INLINE rule3361 #-} + rule3361 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule3362 #-} + rule3362 = \ ((_tlIdictionaryEnvironment) :: DictionaryEnvironment) -> + _tlIdictionaryEnvironment + {-# INLINE rule3363 #-} + rule3363 = \ ((_tlIpatternMatchWarnings) :: [Warning]) -> + _tlIpatternMatchWarnings + {-# INLINE rule3364 #-} + rule3364 = \ ((_tlIuniqueChunk) :: Int) -> + _tlIuniqueChunk + {-# INLINE rule3365 #-} + rule3365 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule3366 #-} + rule3366 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3367 #-} + rule3367 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3368 #-} + rule3368 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3369 #-} + rule3369 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3370 #-} + rule3370 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3371 #-} + rule3371 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3372 #-} + rule3372 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3373 #-} + rule3373 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3374 #-} + rule3374 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3375 #-} + rule3375 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3376 #-} + rule3376 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3377 #-} + rule3377 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3378 #-} + rule3378 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3379 #-} + rule3379 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3380 #-} + rule3380 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule3381 #-} + rule3381 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3382 #-} + rule3382 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3383 #-} + rule3383 = \ ((_hdIcollectErrors) :: TypeErrors) -> + _hdIcollectErrors + {-# INLINE rule3384 #-} + rule3384 = \ ((_hdIcollectWarnings) :: Warnings) -> + _hdIcollectWarnings + {-# INLINE rule3385 #-} + rule3385 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule3386 #-} + rule3386 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3387 #-} + rule3387 = \ ((_hdIdictionaryEnvironment) :: DictionaryEnvironment) -> + _hdIdictionaryEnvironment + {-# INLINE rule3388 #-} + rule3388 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3389 #-} + rule3389 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3390 #-} + rule3390 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3391 #-} + rule3391 = \ ((_hdIpatternMatchWarnings) :: [Warning]) -> + _hdIpatternMatchWarnings + {-# INLINE rule3392 #-} + rule3392 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3393 #-} + rule3393 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3394 #-} + rule3394 = \ ((_hdIuniqueChunk) :: Int) -> + _hdIuniqueChunk +{-# NOINLINE sem_RecordExpressionBindings_Nil #-} +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3395 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3396 () + _self = rule3397 () + _lhsOself :: RecordExpressionBindings + _lhsOself = rule3398 _self + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3399 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3400 _lhsIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule3401 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3402 _lhsIdictionaryEnvironment + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3403 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3404 _lhsIuniqueChunk + __result_ = T_RecordExpressionBindings_vOut139 _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOcounter _lhsOdictionaryEnvironment _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule3395 #-} + rule3395 = \ (_ :: ()) -> + [] + {-# INLINE rule3396 #-} + rule3396 = \ (_ :: ()) -> + [] + {-# INLINE rule3397 #-} + rule3397 = \ (_ :: ()) -> + [] + {-# INLINE rule3398 #-} + rule3398 = \ _self -> + _self + {-# INLINE rule3399 #-} + rule3399 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3400 #-} + rule3400 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3401 #-} + rule3401 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3402 #-} + rule3402 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3403 #-} + rule3403 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3404 #-} + rule3404 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + +-- RecordPatternBinding ---------------------------------------- +-- wrapper +data Inh_RecordPatternBinding = Inh_RecordPatternBinding { counter_Inh_RecordPatternBinding :: (Int), namesInScope_Inh_RecordPatternBinding :: (Names), patternMatchWarnings_Inh_RecordPatternBinding :: ([Warning]) } +data Syn_RecordPatternBinding = Syn_RecordPatternBinding { counter_Syn_RecordPatternBinding :: (Int), patternMatchWarnings_Syn_RecordPatternBinding :: ([Warning]), self_Syn_RecordPatternBinding :: (RecordPatternBinding), unboundNames_Syn_RecordPatternBinding :: (Names) } +{-# INLINABLE wrap_RecordPatternBinding #-} +wrap_RecordPatternBinding :: T_RecordPatternBinding -> Inh_RecordPatternBinding -> (Syn_RecordPatternBinding ) +wrap_RecordPatternBinding (T_RecordPatternBinding act) (Inh_RecordPatternBinding _lhsIcounter _lhsInamesInScope _lhsIpatternMatchWarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBinding_vIn142 _lhsIcounter _lhsInamesInScope _lhsIpatternMatchWarnings + (T_RecordPatternBinding_vOut142 _lhsOcounter _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames) <- return (inv_RecordPatternBinding_s143 sem arg) + return (Syn_RecordPatternBinding _lhsOcounter _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBinding #-} +sem_RecordPatternBinding :: RecordPatternBinding -> T_RecordPatternBinding +sem_RecordPatternBinding ( RecordPatternBinding_RecordPatternBinding range_ name_ pattern_ ) = sem_RecordPatternBinding_RecordPatternBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) + +-- semantic domain +newtype T_RecordPatternBinding = T_RecordPatternBinding { + attach_T_RecordPatternBinding :: Identity (T_RecordPatternBinding_s143 ) + } +newtype T_RecordPatternBinding_s143 = C_RecordPatternBinding_s143 { + inv_RecordPatternBinding_s143 :: (T_RecordPatternBinding_v142 ) + } +data T_RecordPatternBinding_s144 = C_RecordPatternBinding_s144 +type T_RecordPatternBinding_v142 = (T_RecordPatternBinding_vIn142 ) -> (T_RecordPatternBinding_vOut142 ) +data T_RecordPatternBinding_vIn142 = T_RecordPatternBinding_vIn142 (Int) (Names) ([Warning]) +data T_RecordPatternBinding_vOut142 = T_RecordPatternBinding_vOut142 (Int) ([Warning]) (RecordPatternBinding) (Names) +{-# NOINLINE sem_RecordPatternBinding_RecordPatternBinding #-} +sem_RecordPatternBinding_RecordPatternBinding :: T_Range -> T_Name -> T_Pattern -> T_RecordPatternBinding +sem_RecordPatternBinding_RecordPatternBinding arg_range_ arg_name_ arg_pattern_ = T_RecordPatternBinding (return st143) where + {-# NOINLINE st143 #-} + st143 = let + v142 :: T_RecordPatternBinding_v142 + v142 = \ (T_RecordPatternBinding_vIn142 _lhsIcounter _lhsInamesInScope _lhsIpatternMatchWarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIbeta _patternIbetaUnique _patternIconstraints _patternIcounter _patternIelements _patternIenvironment _patternIinfoTree _patternIpatVarNames _patternIpatternMatchWarnings _patternIself _patternIunboundNames) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternObetaUnique _patternOcounter _patternOimportEnvironment _patternOmonos _patternOnamesInScope _patternOparentTree _patternOpatternMatchWarnings) + _parentTree = rule3405 () + (_monos,_constructorenv,_betaUnique,_miscerrors,_warnings,_valueConstructors,_allValueConstructors,_typeConstructors,_allTypeConstructors,_importEnvironment) = rule3406 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3407 _patternIunboundNames + _self = rule3408 _nameIself _patternIself _rangeIself + _lhsOself :: RecordPatternBinding + _lhsOself = rule3409 _self + _lhsOcounter :: Int + _lhsOcounter = rule3410 _patternIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3411 _patternIpatternMatchWarnings + _patternObetaUnique = rule3412 _betaUnique + _patternOcounter = rule3413 _lhsIcounter + _patternOimportEnvironment = rule3414 _importEnvironment + _patternOmonos = rule3415 _monos + _patternOnamesInScope = rule3416 _lhsInamesInScope + _patternOparentTree = rule3417 _parentTree + _patternOpatternMatchWarnings = rule3418 _lhsIpatternMatchWarnings + __result_ = T_RecordPatternBinding_vOut142 _lhsOcounter _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_RecordPatternBinding_s143 v142 + {-# INLINE rule3405 #-} + rule3405 = \ (_ :: ()) -> + globalInfoError + {-# INLINE rule3406 #-} + rule3406 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "RecordPatternBinding.RecordPatternBinding" + {-# INLINE rule3407 #-} + rule3407 = \ ((_patternIunboundNames) :: Names) -> + _patternIunboundNames + {-# INLINE rule3408 #-} + rule3408 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + RecordPatternBinding_RecordPatternBinding _rangeIself _nameIself _patternIself + {-# INLINE rule3409 #-} + rule3409 = \ _self -> + _self + {-# INLINE rule3410 #-} + rule3410 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule3411 #-} + rule3411 = \ ((_patternIpatternMatchWarnings) :: [Warning]) -> + _patternIpatternMatchWarnings + {-# INLINE rule3412 #-} + rule3412 = \ _betaUnique -> + _betaUnique + {-# INLINE rule3413 #-} + rule3413 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3414 #-} + rule3414 = \ _importEnvironment -> + _importEnvironment + {-# INLINE rule3415 #-} + rule3415 = \ _monos -> + _monos + {-# INLINE rule3416 #-} + rule3416 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3417 #-} + rule3417 = \ _parentTree -> + _parentTree + {-# INLINE rule3418 #-} + rule3418 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + +-- RecordPatternBindings --------------------------------------- +-- wrapper +data Inh_RecordPatternBindings = Inh_RecordPatternBindings { counter_Inh_RecordPatternBindings :: (Int), namesInScope_Inh_RecordPatternBindings :: (Names), patternMatchWarnings_Inh_RecordPatternBindings :: ([Warning]) } +data Syn_RecordPatternBindings = Syn_RecordPatternBindings { counter_Syn_RecordPatternBindings :: (Int), patternMatchWarnings_Syn_RecordPatternBindings :: ([Warning]), self_Syn_RecordPatternBindings :: (RecordPatternBindings), unboundNames_Syn_RecordPatternBindings :: (Names) } +{-# INLINABLE wrap_RecordPatternBindings #-} +wrap_RecordPatternBindings :: T_RecordPatternBindings -> Inh_RecordPatternBindings -> (Syn_RecordPatternBindings ) +wrap_RecordPatternBindings (T_RecordPatternBindings act) (Inh_RecordPatternBindings _lhsIcounter _lhsInamesInScope _lhsIpatternMatchWarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBindings_vIn145 _lhsIcounter _lhsInamesInScope _lhsIpatternMatchWarnings + (T_RecordPatternBindings_vOut145 _lhsOcounter _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames) <- return (inv_RecordPatternBindings_s146 sem arg) + return (Syn_RecordPatternBindings _lhsOcounter _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBindings #-} +sem_RecordPatternBindings :: RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings list = Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list) + +-- semantic domain +newtype T_RecordPatternBindings = T_RecordPatternBindings { + attach_T_RecordPatternBindings :: Identity (T_RecordPatternBindings_s146 ) + } +newtype T_RecordPatternBindings_s146 = C_RecordPatternBindings_s146 { + inv_RecordPatternBindings_s146 :: (T_RecordPatternBindings_v145 ) + } +data T_RecordPatternBindings_s147 = C_RecordPatternBindings_s147 +type T_RecordPatternBindings_v145 = (T_RecordPatternBindings_vIn145 ) -> (T_RecordPatternBindings_vOut145 ) +data T_RecordPatternBindings_vIn145 = T_RecordPatternBindings_vIn145 (Int) (Names) ([Warning]) +data T_RecordPatternBindings_vOut145 = T_RecordPatternBindings_vOut145 (Int) ([Warning]) (RecordPatternBindings) (Names) +{-# NOINLINE sem_RecordPatternBindings_Cons #-} +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> T_RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings_Cons arg_hd_ arg_tl_ = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 _lhsIcounter _lhsInamesInScope _lhsIpatternMatchWarnings) -> ( let + _hdX143 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBinding (arg_hd_)) + _tlX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_tl_)) + (T_RecordPatternBinding_vOut142 _hdIcounter _hdIpatternMatchWarnings _hdIself _hdIunboundNames) = inv_RecordPatternBinding_s143 _hdX143 (T_RecordPatternBinding_vIn142 _hdOcounter _hdOnamesInScope _hdOpatternMatchWarnings) + (T_RecordPatternBindings_vOut145 _tlIcounter _tlIpatternMatchWarnings _tlIself _tlIunboundNames) = inv_RecordPatternBindings_s146 _tlX146 (T_RecordPatternBindings_vIn145 _tlOcounter _tlOnamesInScope _tlOpatternMatchWarnings) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3419 _hdIunboundNames _tlIunboundNames + _self = rule3420 _hdIself _tlIself + _lhsOself :: RecordPatternBindings + _lhsOself = rule3421 _self + _lhsOcounter :: Int + _lhsOcounter = rule3422 _tlIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3423 _tlIpatternMatchWarnings + _hdOcounter = rule3424 _lhsIcounter + _hdOnamesInScope = rule3425 _lhsInamesInScope + _hdOpatternMatchWarnings = rule3426 _lhsIpatternMatchWarnings + _tlOcounter = rule3427 _hdIcounter + _tlOnamesInScope = rule3428 _lhsInamesInScope + _tlOpatternMatchWarnings = rule3429 _hdIpatternMatchWarnings + __result_ = T_RecordPatternBindings_vOut145 _lhsOcounter _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule3419 #-} + rule3419 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule3420 #-} + rule3420 = \ ((_hdIself) :: RecordPatternBinding) ((_tlIself) :: RecordPatternBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule3421 #-} + rule3421 = \ _self -> + _self + {-# INLINE rule3422 #-} + rule3422 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule3423 #-} + rule3423 = \ ((_tlIpatternMatchWarnings) :: [Warning]) -> + _tlIpatternMatchWarnings + {-# INLINE rule3424 #-} + rule3424 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3425 #-} + rule3425 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3426 #-} + rule3426 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3427 #-} + rule3427 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule3428 #-} + rule3428 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3429 #-} + rule3429 = \ ((_hdIpatternMatchWarnings) :: [Warning]) -> + _hdIpatternMatchWarnings +{-# NOINLINE sem_RecordPatternBindings_Nil #-} +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 _lhsIcounter _lhsInamesInScope _lhsIpatternMatchWarnings) -> ( let + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3430 () + _self = rule3431 () + _lhsOself :: RecordPatternBindings + _lhsOself = rule3432 _self + _lhsOcounter :: Int + _lhsOcounter = rule3433 _lhsIcounter + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3434 _lhsIpatternMatchWarnings + __result_ = T_RecordPatternBindings_vOut145 _lhsOcounter _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule3430 #-} + rule3430 = \ (_ :: ()) -> + [] + {-# INLINE rule3431 #-} + rule3431 = \ (_ :: ()) -> + [] + {-# INLINE rule3432 #-} + rule3432 = \ _self -> + _self + {-# INLINE rule3433 #-} + rule3433 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3434 #-} + rule3434 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + +-- RightHandSide ----------------------------------------------- +-- wrapper +data Inh_RightHandSide = Inh_RightHandSide { allPatterns_Inh_RightHandSide :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_RightHandSide :: (M.Map NameWithRange TpScheme), availablePredicates_Inh_RightHandSide :: (Predicates), betaRight_Inh_RightHandSide :: (Tp), betaUnique_Inh_RightHandSide :: (Int), classEnvironment_Inh_RightHandSide :: (ClassEnvironment), collectErrors_Inh_RightHandSide :: (TypeErrors), collectWarnings_Inh_RightHandSide :: (Warnings), counter_Inh_RightHandSide :: (Int), currentChunk_Inh_RightHandSide :: (Int), dictionaryEnvironment_Inh_RightHandSide :: (DictionaryEnvironment), importEnvironment_Inh_RightHandSide :: (ImportEnvironment), matchIO_Inh_RightHandSide :: (IO ()), monos_Inh_RightHandSide :: (Monos), namesInScope_Inh_RightHandSide :: (Names), orderedTypeSynonyms_Inh_RightHandSide :: (OrderedTypeSynonyms), parentTree_Inh_RightHandSide :: (InfoTree), patternMatchWarnings_Inh_RightHandSide :: ([Warning]), substitution_Inh_RightHandSide :: (FixpointSubstitution), typeschemeMap_Inh_RightHandSide :: (M.Map Int (Scheme Predicates)), uniqueChunk_Inh_RightHandSide :: (Int) } +data Syn_RightHandSide = Syn_RightHandSide { assumptions_Syn_RightHandSide :: (Assumptions), betaUnique_Syn_RightHandSide :: (Int), collectErrors_Syn_RightHandSide :: (TypeErrors), collectInstances_Syn_RightHandSide :: ([(Name, Instance)]), collectWarnings_Syn_RightHandSide :: (Warnings), constraints_Syn_RightHandSide :: (ConstraintSet), counter_Syn_RightHandSide :: (Int), dictionaryEnvironment_Syn_RightHandSide :: (DictionaryEnvironment), fallthrough_Syn_RightHandSide :: (Bool), infoTree_Syn_RightHandSide :: (InfoTree), matchIO_Syn_RightHandSide :: (IO ()), patternMatchWarnings_Syn_RightHandSide :: ([Warning]), self_Syn_RightHandSide :: (RightHandSide), unboundNames_Syn_RightHandSide :: (Names), uniqueChunk_Syn_RightHandSide :: (Int) } +{-# INLINABLE wrap_RightHandSide #-} +wrap_RightHandSide :: T_RightHandSide -> Inh_RightHandSide -> (Syn_RightHandSide ) +wrap_RightHandSide (T_RightHandSide act) (Inh_RightHandSide _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RightHandSide_vIn148 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk + (T_RightHandSide_vOut148 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOfallthrough _lhsOinfoTree _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk) <- return (inv_RightHandSide_s149 sem arg) + return (Syn_RightHandSide _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOfallthrough _lhsOinfoTree _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk) + ) + +-- cata +{-# NOINLINE sem_RightHandSide #-} +sem_RightHandSide :: RightHandSide -> T_RightHandSide +sem_RightHandSide ( RightHandSide_Expression range_ expression_ where_ ) = sem_RightHandSide_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_MaybeDeclarations where_ ) +sem_RightHandSide ( RightHandSide_Guarded range_ guardedexpressions_ where_ ) = sem_RightHandSide_Guarded ( sem_Range range_ ) ( sem_GuardedExpressions guardedexpressions_ ) ( sem_MaybeDeclarations where_ ) + +-- semantic domain +newtype T_RightHandSide = T_RightHandSide { + attach_T_RightHandSide :: Identity (T_RightHandSide_s149 ) + } +newtype T_RightHandSide_s149 = C_RightHandSide_s149 { + inv_RightHandSide_s149 :: (T_RightHandSide_v148 ) + } +data T_RightHandSide_s150 = C_RightHandSide_s150 +type T_RightHandSide_v148 = (T_RightHandSide_vIn148 ) -> (T_RightHandSide_vOut148 ) +data T_RightHandSide_vIn148 = T_RightHandSide_vIn148 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Predicates) (Tp) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (Int) (Int) (DictionaryEnvironment) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Int) +data T_RightHandSide_vOut148 = T_RightHandSide_vOut148 (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (DictionaryEnvironment) (Bool) (InfoTree) (IO ()) ([Warning]) (RightHandSide) (Names) (Int) +{-# NOINLINE sem_RightHandSide_Expression #-} +sem_RightHandSide_Expression :: T_Range -> T_Expression -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Expression arg_range_ arg_expression_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + (T_MaybeDeclarations_vOut88 _whereIassumptions _whereIbetaUnique _whereIcollectErrors _whereIcollectInstances _whereIcollectWarnings _whereIconstraints _whereIcounter _whereIdictionaryEnvironment _whereIinfoTrees _whereIlocalTypes _whereImatchIO _whereInamesInScope _whereIpatternMatchWarnings _whereIself _whereIunboundNames _whereIuniqueChunk) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOallPatterns _whereOallTypeSchemes _whereOassumptions _whereOavailablePredicates _whereObetaUnique _whereOclassEnvironment _whereOcollectErrors _whereOcollectWarnings _whereOconstraints _whereOcounter _whereOcurrentChunk _whereOdictionaryEnvironment _whereOimportEnvironment _whereOmatchIO _whereOmonos _whereOnamesInScope _whereOorderedTypeSynonyms _whereOparentTree _whereOpatternMatchWarnings _whereOsubstitution _whereOtypeschemeMap _whereOunboundNames _whereOuniqueChunk) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3435 _whereIassumptions + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3436 _whereIconstraints + _whereOassumptions = rule3437 _expressionIassumptions + _whereOconstraints = rule3438 _expressionIconstraints _newcon + _newcon = rule3439 _cinfo _expressionIbeta _lhsIbetaRight + _allTypeSchemes = rule3440 _lhsIallTypeSchemes _whereIlocalTypes + _cinfo = rule3441 _lhsIbetaRight _lhsIparentTree _parentTree + _localInfo = rule3442 _lhsImonos _self + _parentTree = rule3443 _expressionIinfoTree _lhsIparentTree _localInfo _whereIinfoTrees + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3444 _parentTree + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3445 _whereIunboundNames + _expressionOnamesInScope = rule3446 _whereInamesInScope + _whereOunboundNames = rule3447 _expressionIunboundNames + _expressionOuniqueSecondRound = rule3448 _expressionIbetaUnique + _whereObetaUnique = rule3449 _expressionIuniqueSecondRound + _expressionOtryPatterns = rule3450 () + _lhsOfallthrough :: Bool + _lhsOfallthrough = rule3451 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3452 _expressionIcollectInstances _whereIcollectInstances + _self = rule3453 _expressionIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule3454 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3455 _whereIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3456 _whereIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3457 _whereIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule3458 _whereIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3459 _whereIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3460 _whereImatchIO + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3461 _whereIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3462 _whereIuniqueChunk + _expressionOallPatterns = rule3463 _lhsIallPatterns + _expressionOallTypeSchemes = rule3464 _allTypeSchemes + _expressionOavailablePredicates = rule3465 _lhsIavailablePredicates + _expressionObetaUnique = rule3466 _lhsIbetaUnique + _expressionOclassEnvironment = rule3467 _lhsIclassEnvironment + _expressionOcollectErrors = rule3468 _lhsIcollectErrors + _expressionOcollectWarnings = rule3469 _lhsIcollectWarnings + _expressionOcounter = rule3470 _lhsIcounter + _expressionOcurrentChunk = rule3471 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule3472 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule3473 _lhsIimportEnvironment + _expressionOmatchIO = rule3474 _lhsImatchIO + _expressionOmonos = rule3475 _lhsImonos + _expressionOorderedTypeSynonyms = rule3476 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule3477 _parentTree + _expressionOpatternMatchWarnings = rule3478 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule3479 _lhsIsubstitution + _expressionOtypeschemeMap = rule3480 _lhsItypeschemeMap + _expressionOuniqueChunk = rule3481 _lhsIuniqueChunk + _whereOallPatterns = rule3482 _lhsIallPatterns + _whereOallTypeSchemes = rule3483 _allTypeSchemes + _whereOavailablePredicates = rule3484 _lhsIavailablePredicates + _whereOclassEnvironment = rule3485 _lhsIclassEnvironment + _whereOcollectErrors = rule3486 _expressionIcollectErrors + _whereOcollectWarnings = rule3487 _expressionIcollectWarnings + _whereOcounter = rule3488 _expressionIcounter + _whereOcurrentChunk = rule3489 _lhsIcurrentChunk + _whereOdictionaryEnvironment = rule3490 _expressionIdictionaryEnvironment + _whereOimportEnvironment = rule3491 _lhsIimportEnvironment + _whereOmatchIO = rule3492 _expressionImatchIO + _whereOmonos = rule3493 _lhsImonos + _whereOnamesInScope = rule3494 _lhsInamesInScope + _whereOorderedTypeSynonyms = rule3495 _lhsIorderedTypeSynonyms + _whereOparentTree = rule3496 _parentTree + _whereOpatternMatchWarnings = rule3497 _expressionIpatternMatchWarnings + _whereOsubstitution = rule3498 _lhsIsubstitution + _whereOtypeschemeMap = rule3499 _lhsItypeschemeMap + _whereOuniqueChunk = rule3500 _expressionIuniqueChunk + __result_ = T_RightHandSide_vOut148 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOfallthrough _lhsOinfoTree _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule3435 #-} + rule3435 = \ ((_whereIassumptions) :: Assumptions) -> + _whereIassumptions + {-# INLINE rule3436 #-} + rule3436 = \ ((_whereIconstraints) :: ConstraintSet) -> + _whereIconstraints + {-# INLINE rule3437 #-} + rule3437 = \ ((_expressionIassumptions) :: Assumptions) -> + _expressionIassumptions + {-# INLINE rule3438 #-} + rule3438 = \ ((_expressionIconstraints) :: ConstraintSet) _newcon -> + _newcon .>. _expressionIconstraints + {-# INLINE rule3439 #-} + rule3439 = \ _cinfo ((_expressionIbeta) :: Tp) ((_lhsIbetaRight) :: Tp) -> + [ (_expressionIbeta .==. _lhsIbetaRight) _cinfo ] + {-# INLINE rule3440 #-} + rule3440 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) ((_whereIlocalTypes) :: M.Map NameWithRange TpScheme) -> + _whereIlocalTypes `M.union` _lhsIallTypeSchemes + {-# INLINE rule3441 #-} + rule3441 = \ ((_lhsIbetaRight) :: Tp) ((_lhsIparentTree) :: InfoTree) _parentTree -> + orphanConstraint 0 "right-hand side" _parentTree + [ Unifier (head (ftv _lhsIbetaRight)) ("right-hand sides", attribute (skip_UHA_FB_RHS _lhsIparentTree), "right-hand side") ] + {-# INLINE rule3442 #-} + rule3442 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_RHS _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3443 #-} + rule3443 = \ ((_expressionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo ((_whereIinfoTrees) :: InfoTrees) -> + node _lhsIparentTree _localInfo (_expressionIinfoTree : _whereIinfoTrees) + {-# INLINE rule3444 #-} + rule3444 = \ _parentTree -> + _parentTree + {-# INLINE rule3445 #-} + rule3445 = \ ((_whereIunboundNames) :: Names) -> + _whereIunboundNames + {-# INLINE rule3446 #-} + rule3446 = \ ((_whereInamesInScope) :: Names) -> + _whereInamesInScope + {-# INLINE rule3447 #-} + rule3447 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule3448 #-} + rule3448 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule3449 #-} + rule3449 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule3450 #-} + rule3450 = \ (_ :: ()) -> + [] + {-# INLINE rule3451 #-} + rule3451 = \ (_ :: ()) -> + False + {-# INLINE rule3452 #-} + rule3452 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) ((_whereIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances ++ _whereIcollectInstances + {-# INLINE rule3453 #-} + rule3453 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Expression _rangeIself _expressionIself _whereIself + {-# INLINE rule3454 #-} + rule3454 = \ _self -> + _self + {-# INLINE rule3455 #-} + rule3455 = \ ((_whereIbetaUnique) :: Int) -> + _whereIbetaUnique + {-# INLINE rule3456 #-} + rule3456 = \ ((_whereIcollectErrors) :: TypeErrors) -> + _whereIcollectErrors + {-# INLINE rule3457 #-} + rule3457 = \ ((_whereIcollectWarnings) :: Warnings) -> + _whereIcollectWarnings + {-# INLINE rule3458 #-} + rule3458 = \ ((_whereIcounter) :: Int) -> + _whereIcounter + {-# INLINE rule3459 #-} + rule3459 = \ ((_whereIdictionaryEnvironment) :: DictionaryEnvironment) -> + _whereIdictionaryEnvironment + {-# INLINE rule3460 #-} + rule3460 = \ ((_whereImatchIO) :: IO ()) -> + _whereImatchIO + {-# INLINE rule3461 #-} + rule3461 = \ ((_whereIpatternMatchWarnings) :: [Warning]) -> + _whereIpatternMatchWarnings + {-# INLINE rule3462 #-} + rule3462 = \ ((_whereIuniqueChunk) :: Int) -> + _whereIuniqueChunk + {-# INLINE rule3463 #-} + rule3463 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3464 #-} + rule3464 = \ _allTypeSchemes -> + _allTypeSchemes + {-# INLINE rule3465 #-} + rule3465 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3466 #-} + rule3466 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3467 #-} + rule3467 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3468 #-} + rule3468 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3469 #-} + rule3469 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3470 #-} + rule3470 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3471 #-} + rule3471 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3472 #-} + rule3472 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3473 #-} + rule3473 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3474 #-} + rule3474 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3475 #-} + rule3475 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3476 #-} + rule3476 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3477 #-} + rule3477 = \ _parentTree -> + _parentTree + {-# INLINE rule3478 #-} + rule3478 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3479 #-} + rule3479 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3480 #-} + rule3480 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3481 #-} + rule3481 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3482 #-} + rule3482 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3483 #-} + rule3483 = \ _allTypeSchemes -> + _allTypeSchemes + {-# INLINE rule3484 #-} + rule3484 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3485 #-} + rule3485 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3486 #-} + rule3486 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule3487 #-} + rule3487 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule3488 #-} + rule3488 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule3489 #-} + rule3489 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3490 #-} + rule3490 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule3491 #-} + rule3491 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3492 #-} + rule3492 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule3493 #-} + rule3493 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3494 #-} + rule3494 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3495 #-} + rule3495 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3496 #-} + rule3496 = \ _parentTree -> + _parentTree + {-# INLINE rule3497 #-} + rule3497 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule3498 #-} + rule3498 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3499 #-} + rule3499 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3500 #-} + rule3500 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk +{-# NOINLINE sem_RightHandSide_Guarded #-} +sem_RightHandSide_Guarded :: T_Range -> T_GuardedExpressions -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Guarded arg_range_ arg_guardedexpressions_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 _lhsIallPatterns _lhsIallTypeSchemes _lhsIavailablePredicates _lhsIbetaRight _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIuniqueChunk) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardedexpressionsX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_guardedexpressions_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_GuardedExpressions_vOut64 _guardedexpressionsIassumptions _guardedexpressionsIbetaUnique _guardedexpressionsIcollectErrors _guardedexpressionsIcollectInstances _guardedexpressionsIcollectWarnings _guardedexpressionsIconstraintslist _guardedexpressionsIcounter _guardedexpressionsIdictionaryEnvironment _guardedexpressionsIfallthrough _guardedexpressionsIinfoTrees _guardedexpressionsImatchIO _guardedexpressionsIpatternMatchWarnings _guardedexpressionsIself _guardedexpressionsIunboundNames _guardedexpressionsIuniqueChunk _guardedexpressionsIuniqueSecondRound) = inv_GuardedExpressions_s65 _guardedexpressionsX65 (T_GuardedExpressions_vIn64 _guardedexpressionsOallPatterns _guardedexpressionsOallTypeSchemes _guardedexpressionsOavailablePredicates _guardedexpressionsObetaRight _guardedexpressionsObetaUnique _guardedexpressionsOclassEnvironment _guardedexpressionsOcollectErrors _guardedexpressionsOcollectWarnings _guardedexpressionsOcounter _guardedexpressionsOcurrentChunk _guardedexpressionsOdictionaryEnvironment _guardedexpressionsOimportEnvironment _guardedexpressionsOmatchIO _guardedexpressionsOmonos _guardedexpressionsOnamesInScope _guardedexpressionsOnumberOfGuards _guardedexpressionsOopen _guardedexpressionsOorderedTypeSynonyms _guardedexpressionsOparentTree _guardedexpressionsOpatternMatchWarnings _guardedexpressionsOsubstitution _guardedexpressionsOtypeschemeMap _guardedexpressionsOuniqueChunk _guardedexpressionsOuniqueSecondRound) + (T_MaybeDeclarations_vOut88 _whereIassumptions _whereIbetaUnique _whereIcollectErrors _whereIcollectInstances _whereIcollectWarnings _whereIconstraints _whereIcounter _whereIdictionaryEnvironment _whereIinfoTrees _whereIlocalTypes _whereImatchIO _whereInamesInScope _whereIpatternMatchWarnings _whereIself _whereIunboundNames _whereIuniqueChunk) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOallPatterns _whereOallTypeSchemes _whereOassumptions _whereOavailablePredicates _whereObetaUnique _whereOclassEnvironment _whereOcollectErrors _whereOcollectWarnings _whereOconstraints _whereOcounter _whereOcurrentChunk _whereOdictionaryEnvironment _whereOimportEnvironment _whereOmatchIO _whereOmonos _whereOnamesInScope _whereOorderedTypeSynonyms _whereOparentTree _whereOpatternMatchWarnings _whereOsubstitution _whereOtypeschemeMap _whereOunboundNames _whereOuniqueChunk) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3501 _whereIassumptions + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3502 _whereIconstraints + _guardedexpressionsOnumberOfGuards = rule3503 _guardedexpressionsIconstraintslist + _whereOassumptions = rule3504 _guardedexpressionsIassumptions + _whereOconstraints = rule3505 _guardedexpressionsIconstraintslist + _allTypeSchemes = rule3506 _lhsIallTypeSchemes _whereIlocalTypes + _localInfo = rule3507 _lhsImonos _self + _parentTree = rule3508 _guardedexpressionsIinfoTrees _lhsIparentTree _localInfo _whereIinfoTrees + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3509 _parentTree + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3510 _whereIunboundNames + _guardedexpressionsOnamesInScope = rule3511 _whereInamesInScope + _whereOunboundNames = rule3512 _guardedexpressionsIunboundNames + _guardedexpressionsOuniqueSecondRound = rule3513 _guardedexpressionsIbetaUnique + _whereObetaUnique = rule3514 _guardedexpressionsIuniqueSecondRound + _lhsOfallthrough :: Bool + _lhsOfallthrough = rule3515 _guardedexpressionsIfallthrough + _guardedexpressionsOopen = rule3516 () + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3517 _guardedexpressionsIfallthrough _rangeIself _whereIpatternMatchWarnings + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3518 _guardedexpressionsIcollectInstances _whereIcollectInstances + _self = rule3519 _guardedexpressionsIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule3520 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3521 _whereIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3522 _whereIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3523 _whereIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule3524 _whereIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3525 _whereIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3526 _whereImatchIO + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3527 _whereIuniqueChunk + _guardedexpressionsOallPatterns = rule3528 _lhsIallPatterns + _guardedexpressionsOallTypeSchemes = rule3529 _allTypeSchemes + _guardedexpressionsOavailablePredicates = rule3530 _lhsIavailablePredicates + _guardedexpressionsObetaRight = rule3531 _lhsIbetaRight + _guardedexpressionsObetaUnique = rule3532 _lhsIbetaUnique + _guardedexpressionsOclassEnvironment = rule3533 _lhsIclassEnvironment + _guardedexpressionsOcollectErrors = rule3534 _lhsIcollectErrors + _guardedexpressionsOcollectWarnings = rule3535 _lhsIcollectWarnings + _guardedexpressionsOcounter = rule3536 _lhsIcounter + _guardedexpressionsOcurrentChunk = rule3537 _lhsIcurrentChunk + _guardedexpressionsOdictionaryEnvironment = rule3538 _lhsIdictionaryEnvironment + _guardedexpressionsOimportEnvironment = rule3539 _lhsIimportEnvironment + _guardedexpressionsOmatchIO = rule3540 _lhsImatchIO + _guardedexpressionsOmonos = rule3541 _lhsImonos + _guardedexpressionsOorderedTypeSynonyms = rule3542 _lhsIorderedTypeSynonyms + _guardedexpressionsOparentTree = rule3543 _parentTree + _guardedexpressionsOpatternMatchWarnings = rule3544 _lhsIpatternMatchWarnings + _guardedexpressionsOsubstitution = rule3545 _lhsIsubstitution + _guardedexpressionsOtypeschemeMap = rule3546 _lhsItypeschemeMap + _guardedexpressionsOuniqueChunk = rule3547 _lhsIuniqueChunk + _whereOallPatterns = rule3548 _lhsIallPatterns + _whereOallTypeSchemes = rule3549 _allTypeSchemes + _whereOavailablePredicates = rule3550 _lhsIavailablePredicates + _whereOclassEnvironment = rule3551 _lhsIclassEnvironment + _whereOcollectErrors = rule3552 _guardedexpressionsIcollectErrors + _whereOcollectWarnings = rule3553 _guardedexpressionsIcollectWarnings + _whereOcounter = rule3554 _guardedexpressionsIcounter + _whereOcurrentChunk = rule3555 _lhsIcurrentChunk + _whereOdictionaryEnvironment = rule3556 _guardedexpressionsIdictionaryEnvironment + _whereOimportEnvironment = rule3557 _lhsIimportEnvironment + _whereOmatchIO = rule3558 _guardedexpressionsImatchIO + _whereOmonos = rule3559 _lhsImonos + _whereOnamesInScope = rule3560 _lhsInamesInScope + _whereOorderedTypeSynonyms = rule3561 _lhsIorderedTypeSynonyms + _whereOparentTree = rule3562 _parentTree + _whereOpatternMatchWarnings = rule3563 _guardedexpressionsIpatternMatchWarnings + _whereOsubstitution = rule3564 _lhsIsubstitution + _whereOtypeschemeMap = rule3565 _lhsItypeschemeMap + _whereOuniqueChunk = rule3566 _guardedexpressionsIuniqueChunk + __result_ = T_RightHandSide_vOut148 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOfallthrough _lhsOinfoTree _lhsOmatchIO _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule3501 #-} + rule3501 = \ ((_whereIassumptions) :: Assumptions) -> + _whereIassumptions + {-# INLINE rule3502 #-} + rule3502 = \ ((_whereIconstraints) :: ConstraintSet) -> + _whereIconstraints + {-# INLINE rule3503 #-} + rule3503 = \ ((_guardedexpressionsIconstraintslist) :: ConstraintSets) -> + length _guardedexpressionsIconstraintslist + {-# INLINE rule3504 #-} + rule3504 = \ ((_guardedexpressionsIassumptions) :: Assumptions) -> + _guardedexpressionsIassumptions + {-# INLINE rule3505 #-} + rule3505 = \ ((_guardedexpressionsIconstraintslist) :: ConstraintSets) -> + Node _guardedexpressionsIconstraintslist + {-# INLINE rule3506 #-} + rule3506 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) ((_whereIlocalTypes) :: M.Map NameWithRange TpScheme) -> + _whereIlocalTypes `M.union` _lhsIallTypeSchemes + {-# INLINE rule3507 #-} + rule3507 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_RHS _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3508 #-} + rule3508 = \ ((_guardedexpressionsIinfoTrees) :: InfoTrees) ((_lhsIparentTree) :: InfoTree) _localInfo ((_whereIinfoTrees) :: InfoTrees) -> + node _lhsIparentTree _localInfo (_guardedexpressionsIinfoTrees ++ _whereIinfoTrees) + {-# INLINE rule3509 #-} + rule3509 = \ _parentTree -> + _parentTree + {-# INLINE rule3510 #-} + rule3510 = \ ((_whereIunboundNames) :: Names) -> + _whereIunboundNames + {-# INLINE rule3511 #-} + rule3511 = \ ((_whereInamesInScope) :: Names) -> + _whereInamesInScope + {-# INLINE rule3512 #-} + rule3512 = \ ((_guardedexpressionsIunboundNames) :: Names) -> + _guardedexpressionsIunboundNames + {-# INLINE rule3513 #-} + rule3513 = \ ((_guardedexpressionsIbetaUnique) :: Int) -> + _guardedexpressionsIbetaUnique + {-# INLINE rule3514 #-} + rule3514 = \ ((_guardedexpressionsIuniqueSecondRound) :: Int) -> + _guardedexpressionsIuniqueSecondRound + {-# INLINE rule3515 #-} + rule3515 = \ ((_guardedexpressionsIfallthrough) :: Bool) -> + _guardedexpressionsIfallthrough + {-# INLINE rule3516 #-} + rule3516 = \ (_ :: ()) -> + True + {-# INLINE rule3517 #-} + rule3517 = \ ((_guardedexpressionsIfallthrough) :: Bool) ((_rangeIself) :: Range) ((_whereIpatternMatchWarnings) :: [Warning]) -> + (if _guardedexpressionsIfallthrough then [FallThrough _rangeIself] else []) + ++ _whereIpatternMatchWarnings + {-# INLINE rule3518 #-} + rule3518 = \ ((_guardedexpressionsIcollectInstances) :: [(Name, Instance)]) ((_whereIcollectInstances) :: [(Name, Instance)]) -> + _guardedexpressionsIcollectInstances ++ _whereIcollectInstances + {-# INLINE rule3519 #-} + rule3519 = \ ((_guardedexpressionsIself) :: GuardedExpressions) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Guarded _rangeIself _guardedexpressionsIself _whereIself + {-# INLINE rule3520 #-} + rule3520 = \ _self -> + _self + {-# INLINE rule3521 #-} + rule3521 = \ ((_whereIbetaUnique) :: Int) -> + _whereIbetaUnique + {-# INLINE rule3522 #-} + rule3522 = \ ((_whereIcollectErrors) :: TypeErrors) -> + _whereIcollectErrors + {-# INLINE rule3523 #-} + rule3523 = \ ((_whereIcollectWarnings) :: Warnings) -> + _whereIcollectWarnings + {-# INLINE rule3524 #-} + rule3524 = \ ((_whereIcounter) :: Int) -> + _whereIcounter + {-# INLINE rule3525 #-} + rule3525 = \ ((_whereIdictionaryEnvironment) :: DictionaryEnvironment) -> + _whereIdictionaryEnvironment + {-# INLINE rule3526 #-} + rule3526 = \ ((_whereImatchIO) :: IO ()) -> + _whereImatchIO + {-# INLINE rule3527 #-} + rule3527 = \ ((_whereIuniqueChunk) :: Int) -> + _whereIuniqueChunk + {-# INLINE rule3528 #-} + rule3528 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3529 #-} + rule3529 = \ _allTypeSchemes -> + _allTypeSchemes + {-# INLINE rule3530 #-} + rule3530 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3531 #-} + rule3531 = \ ((_lhsIbetaRight) :: Tp) -> + _lhsIbetaRight + {-# INLINE rule3532 #-} + rule3532 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3533 #-} + rule3533 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3534 #-} + rule3534 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3535 #-} + rule3535 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3536 #-} + rule3536 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3537 #-} + rule3537 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3538 #-} + rule3538 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3539 #-} + rule3539 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3540 #-} + rule3540 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3541 #-} + rule3541 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3542 #-} + rule3542 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3543 #-} + rule3543 = \ _parentTree -> + _parentTree + {-# INLINE rule3544 #-} + rule3544 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3545 #-} + rule3545 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3546 #-} + rule3546 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3547 #-} + rule3547 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3548 #-} + rule3548 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3549 #-} + rule3549 = \ _allTypeSchemes -> + _allTypeSchemes + {-# INLINE rule3550 #-} + rule3550 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3551 #-} + rule3551 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3552 #-} + rule3552 = \ ((_guardedexpressionsIcollectErrors) :: TypeErrors) -> + _guardedexpressionsIcollectErrors + {-# INLINE rule3553 #-} + rule3553 = \ ((_guardedexpressionsIcollectWarnings) :: Warnings) -> + _guardedexpressionsIcollectWarnings + {-# INLINE rule3554 #-} + rule3554 = \ ((_guardedexpressionsIcounter) :: Int) -> + _guardedexpressionsIcounter + {-# INLINE rule3555 #-} + rule3555 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3556 #-} + rule3556 = \ ((_guardedexpressionsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _guardedexpressionsIdictionaryEnvironment + {-# INLINE rule3557 #-} + rule3557 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3558 #-} + rule3558 = \ ((_guardedexpressionsImatchIO) :: IO ()) -> + _guardedexpressionsImatchIO + {-# INLINE rule3559 #-} + rule3559 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3560 #-} + rule3560 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3561 #-} + rule3561 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3562 #-} + rule3562 = \ _parentTree -> + _parentTree + {-# INLINE rule3563 #-} + rule3563 = \ ((_guardedexpressionsIpatternMatchWarnings) :: [Warning]) -> + _guardedexpressionsIpatternMatchWarnings + {-# INLINE rule3564 #-} + rule3564 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3565 #-} + rule3565 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3566 #-} + rule3566 = \ ((_guardedexpressionsIuniqueChunk) :: Int) -> + _guardedexpressionsIuniqueChunk + +-- SimpleType -------------------------------------------------- +-- wrapper +data Inh_SimpleType = Inh_SimpleType { } +data Syn_SimpleType = Syn_SimpleType { name_Syn_SimpleType :: (Name), self_Syn_SimpleType :: (SimpleType), typevariables_Syn_SimpleType :: (Names) } +{-# INLINABLE wrap_SimpleType #-} +wrap_SimpleType :: T_SimpleType -> Inh_SimpleType -> (Syn_SimpleType ) +wrap_SimpleType (T_SimpleType act) (Inh_SimpleType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_SimpleType_vIn151 + (T_SimpleType_vOut151 _lhsOname _lhsOself _lhsOtypevariables) <- return (inv_SimpleType_s152 sem arg) + return (Syn_SimpleType _lhsOname _lhsOself _lhsOtypevariables) + ) + +-- cata +{-# INLINE sem_SimpleType #-} +sem_SimpleType :: SimpleType -> T_SimpleType +sem_SimpleType ( SimpleType_SimpleType range_ name_ typevariables_ ) = sem_SimpleType_SimpleType ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Names typevariables_ ) + +-- semantic domain +newtype T_SimpleType = T_SimpleType { + attach_T_SimpleType :: Identity (T_SimpleType_s152 ) + } +newtype T_SimpleType_s152 = C_SimpleType_s152 { + inv_SimpleType_s152 :: (T_SimpleType_v151 ) + } +data T_SimpleType_s153 = C_SimpleType_s153 +type T_SimpleType_v151 = (T_SimpleType_vIn151 ) -> (T_SimpleType_vOut151 ) +data T_SimpleType_vIn151 = T_SimpleType_vIn151 +data T_SimpleType_vOut151 = T_SimpleType_vOut151 (Name) (SimpleType) (Names) +{-# NOINLINE sem_SimpleType_SimpleType #-} +sem_SimpleType_SimpleType :: T_Range -> T_Name -> T_Names -> T_SimpleType +sem_SimpleType_SimpleType arg_range_ arg_name_ arg_typevariables_ = T_SimpleType (return st152) where + {-# NOINLINE st152 #-} + st152 = let + v151 :: T_SimpleType_v151 + v151 = \ (T_SimpleType_vIn151 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + _lhsOname :: Name + _lhsOname = rule3567 _nameIself + _lhsOtypevariables :: Names + _lhsOtypevariables = rule3568 _typevariablesIself + _self = rule3569 _nameIself _rangeIself _typevariablesIself + _lhsOself :: SimpleType + _lhsOself = rule3570 _self + __result_ = T_SimpleType_vOut151 _lhsOname _lhsOself _lhsOtypevariables + in __result_ ) + in C_SimpleType_s152 v151 + {-# INLINE rule3567 #-} + rule3567 = \ ((_nameIself) :: Name) -> + _nameIself + {-# INLINE rule3568 #-} + rule3568 = \ ((_typevariablesIself) :: Names) -> + _typevariablesIself + {-# INLINE rule3569 #-} + rule3569 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typevariablesIself) :: Names) -> + SimpleType_SimpleType _rangeIself _nameIself _typevariablesIself + {-# INLINE rule3570 #-} + rule3570 = \ _self -> + _self + +-- Statement --------------------------------------------------- +-- wrapper +data Inh_Statement = Inh_Statement { allPatterns_Inh_Statement :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_Statement :: (M.Map NameWithRange TpScheme), assumptions_Inh_Statement :: (Assumptions), availablePredicates_Inh_Statement :: (Predicates), betaUnique_Inh_Statement :: (Int), classEnvironment_Inh_Statement :: (ClassEnvironment), collectErrors_Inh_Statement :: (TypeErrors), collectWarnings_Inh_Statement :: (Warnings), constraints_Inh_Statement :: (ConstraintSet), counter_Inh_Statement :: (Int), currentChunk_Inh_Statement :: (Int), dictionaryEnvironment_Inh_Statement :: (DictionaryEnvironment), generatorBeta_Inh_Statement :: (Maybe Tp), importEnvironment_Inh_Statement :: (ImportEnvironment), matchIO_Inh_Statement :: (IO ()), monos_Inh_Statement :: (Monos), namesInScope_Inh_Statement :: (Names), orderedTypeSynonyms_Inh_Statement :: (OrderedTypeSynonyms), parentTree_Inh_Statement :: (InfoTree), patternMatchWarnings_Inh_Statement :: ([Warning]), substitution_Inh_Statement :: (FixpointSubstitution), typeschemeMap_Inh_Statement :: (M.Map Int (Scheme Predicates)), unboundNames_Inh_Statement :: (Names), uniqueChunk_Inh_Statement :: (Int), uniqueSecondRound_Inh_Statement :: (Int) } +data Syn_Statement = Syn_Statement { assumptions_Syn_Statement :: (Assumptions), betaUnique_Syn_Statement :: (Int), collectErrors_Syn_Statement :: (TypeErrors), collectInstances_Syn_Statement :: ([(Name, Instance)]), collectWarnings_Syn_Statement :: (Warnings), constraints_Syn_Statement :: (ConstraintSet), counter_Syn_Statement :: (Int), dictionaryEnvironment_Syn_Statement :: (DictionaryEnvironment), generatorBeta_Syn_Statement :: (Maybe Tp), infoTree_Syn_Statement :: (InfoTree), matchIO_Syn_Statement :: (IO ()), monos_Syn_Statement :: (Monos), namesInScope_Syn_Statement :: (Names), patternMatchWarnings_Syn_Statement :: ([Warning]), self_Syn_Statement :: (Statement), unboundNames_Syn_Statement :: (Names), uniqueChunk_Syn_Statement :: (Int), uniqueSecondRound_Syn_Statement :: (Int) } +{-# INLINABLE wrap_Statement #-} +wrap_Statement :: T_Statement -> Inh_Statement -> (Syn_Statement ) +wrap_Statement (T_Statement act) (Inh_Statement _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIgeneratorBeta _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statement_vIn154 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIgeneratorBeta _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound + (T_Statement_vOut154 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOgeneratorBeta _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) <- return (inv_Statement_s155 sem arg) + return (Syn_Statement _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOgeneratorBeta _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) + ) + +-- cata +{-# NOINLINE sem_Statement #-} +sem_Statement :: Statement -> T_Statement +sem_Statement ( Statement_Expression range_ expression_ ) = sem_Statement_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Let range_ declarations_ ) = sem_Statement_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Statement ( Statement_Generator range_ pattern_ expression_ ) = sem_Statement_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Empty range_ ) = sem_Statement_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Statement = T_Statement { + attach_T_Statement :: Identity (T_Statement_s155 ) + } +newtype T_Statement_s155 = C_Statement_s155 { + inv_Statement_s155 :: (T_Statement_v154 ) + } +data T_Statement_s156 = C_Statement_s156 +type T_Statement_v154 = (T_Statement_vIn154 ) -> (T_Statement_vOut154 ) +data T_Statement_vIn154 = T_Statement_vIn154 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Assumptions) (Predicates) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (ConstraintSet) (Int) (Int) (DictionaryEnvironment) (Maybe Tp) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Names) (Int) (Int) +data T_Statement_vOut154 = T_Statement_vOut154 (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (DictionaryEnvironment) (Maybe Tp) (InfoTree) (IO ()) (Monos) (Names) ([Warning]) (Statement) (Names) (Int) (Int) +{-# NOINLINE sem_Statement_Expression #-} +sem_Statement_Expression :: T_Range -> T_Expression -> T_Statement +sem_Statement_Expression arg_range_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIgeneratorBeta _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _lhsOgeneratorBeta :: Maybe Tp + _lhsOgeneratorBeta = rule3571 _beta + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3572 _expressionIassumptions _lhsIassumptions + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3573 _locConstraints + _expressionObetaUnique = rule3574 _lhsIbetaUnique + _locConstraints = rule3575 _expressionIconstraints _lhsIconstraints _newcon + _beta = rule3576 _lhsIbetaUnique + _newcon = rule3577 _beta _cinfo _expressionIbeta + _cinfo = rule3578 _parentTree + _localInfo = rule3579 _lhsImonos _self + _parentTree = rule3580 _expressionIinfoTree _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3581 _parentTree + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3582 _expressionIunboundNames _lhsIunboundNames + _expressionOtryPatterns = rule3583 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3584 _expressionIcollectInstances + _self = rule3585 _expressionIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule3586 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3587 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3588 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3589 _expressionIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule3590 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3591 _expressionIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3592 _expressionImatchIO + _lhsOmonos :: Monos + _lhsOmonos = rule3593 _lhsImonos + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3594 _lhsInamesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3595 _expressionIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3596 _expressionIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3597 _expressionIuniqueSecondRound + _expressionOallPatterns = rule3598 _lhsIallPatterns + _expressionOallTypeSchemes = rule3599 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule3600 _lhsIavailablePredicates + _expressionOclassEnvironment = rule3601 _lhsIclassEnvironment + _expressionOcollectErrors = rule3602 _lhsIcollectErrors + _expressionOcollectWarnings = rule3603 _lhsIcollectWarnings + _expressionOcounter = rule3604 _lhsIcounter + _expressionOcurrentChunk = rule3605 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule3606 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule3607 _lhsIimportEnvironment + _expressionOmatchIO = rule3608 _lhsImatchIO + _expressionOmonos = rule3609 _lhsImonos + _expressionOnamesInScope = rule3610 _lhsInamesInScope + _expressionOorderedTypeSynonyms = rule3611 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule3612 _parentTree + _expressionOpatternMatchWarnings = rule3613 _lhsIpatternMatchWarnings + _expressionOsubstitution = rule3614 _lhsIsubstitution + _expressionOtypeschemeMap = rule3615 _lhsItypeschemeMap + _expressionOuniqueChunk = rule3616 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule3617 _lhsIuniqueSecondRound + __result_ = T_Statement_vOut154 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOgeneratorBeta _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule3571 #-} + rule3571 = \ _beta -> + Just _beta + {-# INLINE rule3572 #-} + rule3572 = \ ((_expressionIassumptions) :: Assumptions) ((_lhsIassumptions) :: Assumptions) -> + _lhsIassumptions `combine` _expressionIassumptions + {-# INLINE rule3573 #-} + rule3573 = \ _locConstraints -> + _locConstraints + {-# INLINE rule3574 #-} + rule3574 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + 1 + {-# INLINE rule3575 #-} + rule3575 = \ ((_expressionIconstraints) :: ConstraintSet) ((_lhsIconstraints) :: ConstraintSet) _newcon -> + Node [ _newcon .<. _expressionIconstraints + , _lhsIconstraints + ] + {-# INLINE rule3576 #-} + rule3576 = \ ((_lhsIbetaUnique) :: Int) -> + TVar _lhsIbetaUnique + {-# INLINE rule3577 #-} + rule3577 = \ _beta _cinfo ((_expressionIbeta) :: Tp) -> + [ (_expressionIbeta .==. ioType _beta) _cinfo ] + {-# INLINE rule3578 #-} + rule3578 = \ _parentTree -> + orphanConstraint 0 "generator" _parentTree + [] + {-# INLINE rule3579 #-} + rule3579 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Stat _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3580 #-} + rule3580 = \ ((_expressionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [_expressionIinfoTree] + {-# INLINE rule3581 #-} + rule3581 = \ _parentTree -> + _parentTree + {-# INLINE rule3582 #-} + rule3582 = \ ((_expressionIunboundNames) :: Names) ((_lhsIunboundNames) :: Names) -> + _expressionIunboundNames ++ _lhsIunboundNames + {-# INLINE rule3583 #-} + rule3583 = \ (_ :: ()) -> + [] + {-# INLINE rule3584 #-} + rule3584 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule3585 #-} + rule3585 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Statement_Expression _rangeIself _expressionIself + {-# INLINE rule3586 #-} + rule3586 = \ _self -> + _self + {-# INLINE rule3587 #-} + rule3587 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule3588 #-} + rule3588 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule3589 #-} + rule3589 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule3590 #-} + rule3590 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule3591 #-} + rule3591 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule3592 #-} + rule3592 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule3593 #-} + rule3593 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3594 #-} + rule3594 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3595 #-} + rule3595 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) -> + _expressionIpatternMatchWarnings + {-# INLINE rule3596 #-} + rule3596 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule3597 #-} + rule3597 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule3598 #-} + rule3598 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3599 #-} + rule3599 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule3600 #-} + rule3600 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3601 #-} + rule3601 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3602 #-} + rule3602 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3603 #-} + rule3603 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3604 #-} + rule3604 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3605 #-} + rule3605 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3606 #-} + rule3606 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3607 #-} + rule3607 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3608 #-} + rule3608 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3609 #-} + rule3609 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3610 #-} + rule3610 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3611 #-} + rule3611 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3612 #-} + rule3612 = \ _parentTree -> + _parentTree + {-# INLINE rule3613 #-} + rule3613 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3614 #-} + rule3614 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3615 #-} + rule3615 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3616 #-} + rule3616 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3617 #-} + rule3617 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Statement_Let #-} +sem_Statement_Let :: T_Range -> T_Declarations -> T_Statement +sem_Statement_Let arg_range_ arg_declarations_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIgeneratorBeta _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIbetaUnique _declarationsIbindingGroups _declarationsIcollectErrors _declarationsIcollectInstances _declarationsIcollectWarnings _declarationsIcounter _declarationsIdeclVarNames _declarationsIdictionaryEnvironment _declarationsIinfoTrees _declarationsImatchIO _declarationsIpatternMatchWarnings _declarationsIrestrictedNames _declarationsIself _declarationsIsimplePatNames _declarationsItypeSignatures _declarationsIunboundNames _declarationsIuniqueChunk) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOallPatterns _declarationsOallTypeSchemes _declarationsOavailablePredicates _declarationsObetaUnique _declarationsObindingGroups _declarationsOclassEnvironment _declarationsOcollectErrors _declarationsOcollectWarnings _declarationsOcounter _declarationsOcurrentChunk _declarationsOdictionaryEnvironment _declarationsOimportEnvironment _declarationsOinheritedBDG _declarationsOmatchIO _declarationsOmonos _declarationsOnamesInScope _declarationsOorderedTypeSynonyms _declarationsOparentTree _declarationsOpatternMatchWarnings _declarationsOsubstitution _declarationsOtypeSignatures _declarationsOtypeschemeMap _declarationsOuniqueChunk) + _lhsOgeneratorBeta :: Maybe Tp + _lhsOgeneratorBeta = rule3618 () + _declarationsObindingGroups = rule3619 () + _lhsOassumptions :: Assumptions + _lhsOconstraints :: ConstraintSet + _lhsObetaUnique :: Int + (_lhsOassumptions,_lhsOconstraints,_inheritedBDG,_chunkNr,_lhsObetaUnique,_implicitsFM) = rule3620 _declarationsIbetaUnique _declarationsIbindingGroups _declarationsItypeSignatures _declarationsIuniqueChunk _lhsIassumptions _lhsIconstraints _lhsIcurrentChunk _lhsImonos + _inferredTypes = rule3621 _implicitsFM _lhsItypeschemeMap + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3622 _declarationsIcollectWarnings _declarationsIsimplePatNames _inferredTypes + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3623 _declarationsIcollectErrors _declarationsIrestrictedNames _inferredTypes + _allTypeSchemes = rule3624 _lhsIallTypeSchemes _localTypes + _localTypes = rule3625 _declarationsIbindingGroups _declarationsItypeSignatures _inferredTypes + _declarationsOtypeSignatures = rule3626 () + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3627 _chunkNr + _localInfo = rule3628 _lhsImonos _self + _declInfo = rule3629 _declarationsIself _lhsImonos + _thisTree = rule3630 _declTree _lhsIparentTree _localInfo + _declTree = rule3631 _declInfo _declarationsIinfoTrees _thisTree + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3632 _thisTree + _declarationsOparentTree = rule3633 _declTree + (_collectTypeConstructors,_collectValueConstructors,_collectTypeSynonyms,_collectConstructorEnv,_derivedFunctions,_operatorFixities) = rule3634 () + (_namesInScope,_unboundNames,_scopeInfo) = rule3635 _declarationsIdeclVarNames _declarationsIunboundNames _lhsInamesInScope _lhsIunboundNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3636 _unboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3637 _declarationsIcollectInstances + _self = rule3638 _declarationsIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule3639 _self + _lhsOcounter :: Int + _lhsOcounter = rule3640 _declarationsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3641 _declarationsIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3642 _declarationsImatchIO + _lhsOmonos :: Monos + _lhsOmonos = rule3643 _lhsImonos + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3644 _namesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3645 _declarationsIpatternMatchWarnings + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3646 _lhsIuniqueSecondRound + _declarationsOallPatterns = rule3647 _lhsIallPatterns + _declarationsOallTypeSchemes = rule3648 _allTypeSchemes + _declarationsOavailablePredicates = rule3649 _lhsIavailablePredicates + _declarationsObetaUnique = rule3650 _lhsIbetaUnique + _declarationsOclassEnvironment = rule3651 _lhsIclassEnvironment + _declarationsOcollectErrors = rule3652 _lhsIcollectErrors + _declarationsOcollectWarnings = rule3653 _lhsIcollectWarnings + _declarationsOcounter = rule3654 _lhsIcounter + _declarationsOcurrentChunk = rule3655 _lhsIcurrentChunk + _declarationsOdictionaryEnvironment = rule3656 _lhsIdictionaryEnvironment + _declarationsOimportEnvironment = rule3657 _lhsIimportEnvironment + _declarationsOinheritedBDG = rule3658 _inheritedBDG + _declarationsOmatchIO = rule3659 _lhsImatchIO + _declarationsOmonos = rule3660 _lhsImonos + _declarationsOnamesInScope = rule3661 _namesInScope + _declarationsOorderedTypeSynonyms = rule3662 _lhsIorderedTypeSynonyms + _declarationsOpatternMatchWarnings = rule3663 _lhsIpatternMatchWarnings + _declarationsOsubstitution = rule3664 _lhsIsubstitution + _declarationsOtypeschemeMap = rule3665 _lhsItypeschemeMap + _declarationsOuniqueChunk = rule3666 _lhsIuniqueChunk + __result_ = T_Statement_vOut154 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOgeneratorBeta _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule3618 #-} + rule3618 = \ (_ :: ()) -> + Nothing + {-# INLINE rule3619 #-} + rule3619 = \ (_ :: ()) -> + [] + {-# INLINE rule3620 #-} + rule3620 = \ ((_declarationsIbetaUnique) :: Int) ((_declarationsIbindingGroups) :: BindingGroups) ((_declarationsItypeSignatures) :: TypeEnvironment) ((_declarationsIuniqueChunk) :: Int) ((_lhsIassumptions) :: Assumptions) ((_lhsIconstraints) :: ConstraintSet) ((_lhsIcurrentChunk) :: Int) ((_lhsImonos) :: Monos) -> + let inputBDG = (False, _lhsIcurrentChunk, _declarationsIuniqueChunk, _lhsImonos, _declarationsItypeSignatures, mybdggroup, _declarationsIbetaUnique) + mybdggroup = Just (_lhsIassumptions, [_lhsIconstraints]) + in performBindingGroup inputBDG _declarationsIbindingGroups + {-# INLINE rule3621 #-} + rule3621 = \ _implicitsFM ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + findInferredTypes _lhsItypeschemeMap _implicitsFM + {-# INLINE rule3622 #-} + rule3622 = \ ((_declarationsIcollectWarnings) :: Warnings) ((_declarationsIsimplePatNames) :: Names) _inferredTypes -> + missingTypeSignature False _declarationsIsimplePatNames _inferredTypes + ++ _declarationsIcollectWarnings + {-# INLINE rule3623 #-} + rule3623 = \ ((_declarationsIcollectErrors) :: TypeErrors) ((_declarationsIrestrictedNames) :: Names) _inferredTypes -> + restrictedNameErrors _inferredTypes _declarationsIrestrictedNames + ++ _declarationsIcollectErrors + {-# INLINE rule3624 #-} + rule3624 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) _localTypes -> + _localTypes `M.union` _lhsIallTypeSchemes + {-# INLINE rule3625 #-} + rule3625 = \ ((_declarationsIbindingGroups) :: BindingGroups) ((_declarationsItypeSignatures) :: TypeEnvironment) _inferredTypes -> + makeLocalTypeEnv (_declarationsItypeSignatures `M.union` _inferredTypes) _declarationsIbindingGroups + {-# INLINE rule3626 #-} + rule3626 = \ (_ :: ()) -> + M.empty + {-# INLINE rule3627 #-} + rule3627 = \ _chunkNr -> + _chunkNr + {-# INLINE rule3628 #-} + rule3628 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Stat _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3629 #-} + rule3629 = \ ((_declarationsIself) :: Declarations) ((_lhsImonos) :: Monos) -> + LocalInfo { self = UHA_Decls _declarationsIself + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3630 #-} + rule3630 = \ _declTree ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [_declTree] + {-# INLINE rule3631 #-} + rule3631 = \ _declInfo ((_declarationsIinfoTrees) :: InfoTrees) _thisTree -> + node _thisTree _declInfo _declarationsIinfoTrees + {-# INLINE rule3632 #-} + rule3632 = \ _thisTree -> + _thisTree + {-# INLINE rule3633 #-} + rule3633 = \ _declTree -> + _declTree + {-# INLINE rule3634 #-} + rule3634 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "toplevel Statement" + {-# INLINE rule3635 #-} + rule3635 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsIunboundNames) :: Names) -> + changeOfScope _declarationsIdeclVarNames (_declarationsIunboundNames ++ _lhsIunboundNames) _lhsInamesInScope + {-# INLINE rule3636 #-} + rule3636 = \ _unboundNames -> + _unboundNames + {-# INLINE rule3637 #-} + rule3637 = \ ((_declarationsIcollectInstances) :: [(Name, Instance)]) -> + _declarationsIcollectInstances + {-# INLINE rule3638 #-} + rule3638 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Statement_Let _rangeIself _declarationsIself + {-# INLINE rule3639 #-} + rule3639 = \ _self -> + _self + {-# INLINE rule3640 #-} + rule3640 = \ ((_declarationsIcounter) :: Int) -> + _declarationsIcounter + {-# INLINE rule3641 #-} + rule3641 = \ ((_declarationsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _declarationsIdictionaryEnvironment + {-# INLINE rule3642 #-} + rule3642 = \ ((_declarationsImatchIO) :: IO ()) -> + _declarationsImatchIO + {-# INLINE rule3643 #-} + rule3643 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3644 #-} + rule3644 = \ _namesInScope -> + _namesInScope + {-# INLINE rule3645 #-} + rule3645 = \ ((_declarationsIpatternMatchWarnings) :: [Warning]) -> + _declarationsIpatternMatchWarnings + {-# INLINE rule3646 #-} + rule3646 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule3647 #-} + rule3647 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3648 #-} + rule3648 = \ _allTypeSchemes -> + _allTypeSchemes + {-# INLINE rule3649 #-} + rule3649 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3650 #-} + rule3650 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3651 #-} + rule3651 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3652 #-} + rule3652 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3653 #-} + rule3653 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3654 #-} + rule3654 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3655 #-} + rule3655 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3656 #-} + rule3656 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3657 #-} + rule3657 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3658 #-} + rule3658 = \ _inheritedBDG -> + _inheritedBDG + {-# INLINE rule3659 #-} + rule3659 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3660 #-} + rule3660 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3661 #-} + rule3661 = \ _namesInScope -> + _namesInScope + {-# INLINE rule3662 #-} + rule3662 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3663 #-} + rule3663 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3664 #-} + rule3664 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3665 #-} + rule3665 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3666 #-} + rule3666 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk +{-# NOINLINE sem_Statement_Generator #-} +sem_Statement_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Statement +sem_Statement_Generator arg_range_ arg_pattern_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIgeneratorBeta _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIbeta _patternIbetaUnique _patternIconstraints _patternIcounter _patternIelements _patternIenvironment _patternIinfoTree _patternIpatVarNames _patternIpatternMatchWarnings _patternIself _patternIunboundNames) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternObetaUnique _patternOcounter _patternOimportEnvironment _patternOmonos _patternOnamesInScope _patternOparentTree _patternOpatternMatchWarnings) + (T_Expression_vOut40 _expressionIassumptions _expressionIbeta _expressionIbetaUnique _expressionIcollectErrors _expressionIcollectInstances _expressionIcollectWarnings _expressionIconstraints _expressionIcounter _expressionIdictionaryEnvironment _expressionIinfoTree _expressionImatchIO _expressionImatches _expressionIpatternMatchWarnings _expressionIself _expressionIunboundNames _expressionIuniqueChunk _expressionIuniqueSecondRound) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallPatterns _expressionOallTypeSchemes _expressionOavailablePredicates _expressionObetaUnique _expressionOclassEnvironment _expressionOcollectErrors _expressionOcollectWarnings _expressionOcounter _expressionOcurrentChunk _expressionOdictionaryEnvironment _expressionOimportEnvironment _expressionOmatchIO _expressionOmonos _expressionOnamesInScope _expressionOorderedTypeSynonyms _expressionOparentTree _expressionOpatternMatchWarnings _expressionOsubstitution _expressionOtryPatterns _expressionOtypeschemeMap _expressionOuniqueChunk _expressionOuniqueSecondRound) + _lhsOgeneratorBeta :: Maybe Tp + _lhsOgeneratorBeta = rule3667 () + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3668 _locConstraints + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3669 _assumptions' _expressionIassumptions + _lhsOmonos :: Monos + _lhsOmonos = rule3670 _csetBinds _lhsImonos _patternIenvironment + _locConstraints = rule3671 _csetBinds _expressionIconstraints _lhsIconstraints _newcon _patternIconstraints + _newcon = rule3672 _cinfoResult _expressionIbeta _patternIbeta + (_csetBinds,_assumptions') = rule3673 _cinfoBind _lhsIassumptions _patternIenvironment + _cinfoResult = rule3674 _parentTree + _cinfoBind = rule3675 _parentTree _patternIenvironment + _localInfo = rule3676 _lhsImonos _self + _parentTree = rule3677 _expressionIinfoTree _lhsIparentTree _localInfo _patternIinfoTree + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3678 _parentTree + (_namesInScope,_unboundNames,_scopeInfo) = rule3679 _expressionIunboundNames _lhsInamesInScope _lhsIunboundNames _patternIpatVarNames + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3680 _namesInScope + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3681 _unboundNames + _expressionOnamesInScope = rule3682 _lhsInamesInScope + _expressionOtryPatterns = rule3683 () + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3684 _expressionIpatternMatchWarnings _lhsIimportEnvironment _lhsIsubstitution _patternIbeta _patternIelements _rangeIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3685 _expressionIcollectInstances + _self = rule3686 _expressionIself _patternIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule3687 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3688 _expressionIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3689 _expressionIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3690 _expressionIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule3691 _expressionIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3692 _expressionIdictionaryEnvironment + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3693 _expressionImatchIO + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3694 _expressionIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3695 _expressionIuniqueSecondRound + _patternObetaUnique = rule3696 _lhsIbetaUnique + _patternOcounter = rule3697 _lhsIcounter + _patternOimportEnvironment = rule3698 _lhsIimportEnvironment + _patternOmonos = rule3699 _lhsImonos + _patternOnamesInScope = rule3700 _namesInScope + _patternOparentTree = rule3701 _parentTree + _patternOpatternMatchWarnings = rule3702 _lhsIpatternMatchWarnings + _expressionOallPatterns = rule3703 _lhsIallPatterns + _expressionOallTypeSchemes = rule3704 _lhsIallTypeSchemes + _expressionOavailablePredicates = rule3705 _lhsIavailablePredicates + _expressionObetaUnique = rule3706 _patternIbetaUnique + _expressionOclassEnvironment = rule3707 _lhsIclassEnvironment + _expressionOcollectErrors = rule3708 _lhsIcollectErrors + _expressionOcollectWarnings = rule3709 _lhsIcollectWarnings + _expressionOcounter = rule3710 _patternIcounter + _expressionOcurrentChunk = rule3711 _lhsIcurrentChunk + _expressionOdictionaryEnvironment = rule3712 _lhsIdictionaryEnvironment + _expressionOimportEnvironment = rule3713 _lhsIimportEnvironment + _expressionOmatchIO = rule3714 _lhsImatchIO + _expressionOmonos = rule3715 _lhsImonos + _expressionOorderedTypeSynonyms = rule3716 _lhsIorderedTypeSynonyms + _expressionOparentTree = rule3717 _parentTree + _expressionOpatternMatchWarnings = rule3718 _patternIpatternMatchWarnings + _expressionOsubstitution = rule3719 _lhsIsubstitution + _expressionOtypeschemeMap = rule3720 _lhsItypeschemeMap + _expressionOuniqueChunk = rule3721 _lhsIuniqueChunk + _expressionOuniqueSecondRound = rule3722 _lhsIuniqueSecondRound + __result_ = T_Statement_vOut154 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOgeneratorBeta _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule3667 #-} + rule3667 = \ (_ :: ()) -> + Nothing + {-# INLINE rule3668 #-} + rule3668 = \ _locConstraints -> + _locConstraints + {-# INLINE rule3669 #-} + rule3669 = \ _assumptions' ((_expressionIassumptions) :: Assumptions) -> + _assumptions' `combine` _expressionIassumptions + {-# INLINE rule3670 #-} + rule3670 = \ _csetBinds ((_lhsImonos) :: Monos) ((_patternIenvironment) :: PatternAssumptions) -> + M.elems _patternIenvironment ++ getMonos _csetBinds ++ _lhsImonos + {-# INLINE rule3671 #-} + rule3671 = \ _csetBinds ((_expressionIconstraints) :: ConstraintSet) ((_lhsIconstraints) :: ConstraintSet) _newcon ((_patternIconstraints) :: ConstraintSet) -> + _newcon .>. _csetBinds .>>. + Node [ _patternIconstraints + , _expressionIconstraints + , _lhsIconstraints + ] + {-# INLINE rule3672 #-} + rule3672 = \ _cinfoResult ((_expressionIbeta) :: Tp) ((_patternIbeta) :: Tp) -> + [ (_expressionIbeta .==. ioType _patternIbeta) _cinfoResult ] + {-# INLINE rule3673 #-} + rule3673 = \ _cinfoBind ((_lhsIassumptions) :: Assumptions) ((_patternIenvironment) :: PatternAssumptions) -> + (_patternIenvironment .===. _lhsIassumptions) _cinfoBind + {-# INLINE rule3674 #-} + rule3674 = \ _parentTree -> + childConstraint 1 "generator" _parentTree + [] + {-# INLINE rule3675 #-} + rule3675 = \ _parentTree ((_patternIenvironment) :: PatternAssumptions) -> + \name -> variableConstraint "variable" (nameToUHA_Expr name) + [ FolkloreConstraint + , makeUnifier name "generator" _patternIenvironment _parentTree + ] + {-# INLINE rule3676 #-} + rule3676 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Stat _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3677 #-} + rule3677 = \ ((_expressionIinfoTree) :: InfoTree) ((_lhsIparentTree) :: InfoTree) _localInfo ((_patternIinfoTree) :: InfoTree) -> + node _lhsIparentTree _localInfo [_patternIinfoTree, _expressionIinfoTree] + {-# INLINE rule3678 #-} + rule3678 = \ _parentTree -> + _parentTree + {-# INLINE rule3679 #-} + rule3679 = \ ((_expressionIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsIunboundNames) :: Names) ((_patternIpatVarNames) :: Names) -> + changeOfScope _patternIpatVarNames (_expressionIunboundNames ++ _lhsIunboundNames) _lhsInamesInScope + {-# INLINE rule3680 #-} + rule3680 = \ _namesInScope -> + _namesInScope + {-# INLINE rule3681 #-} + rule3681 = \ _unboundNames -> + _unboundNames + {-# INLINE rule3682 #-} + rule3682 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3683 #-} + rule3683 = \ (_ :: ()) -> + [] + {-# INLINE rule3684 #-} + rule3684 = \ ((_expressionIpatternMatchWarnings) :: [Warning]) ((_lhsIimportEnvironment) :: ImportEnvironment) ((_lhsIsubstitution) :: FixpointSubstitution) ((_patternIbeta) :: Tp) ((_patternIelements) :: [PatternElement] ) ((_rangeIself) :: Range) -> + patternMatchWarnings _lhsIimportEnvironment + _lhsIsubstitution + _patternIbeta + (:[]) + [(_patternIelements, False)] + _rangeIself + Nothing + False + [] + "generator" + "<-" + ++ _expressionIpatternMatchWarnings + {-# INLINE rule3685 #-} + rule3685 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule3686 #-} + rule3686 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Statement_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule3687 #-} + rule3687 = \ _self -> + _self + {-# INLINE rule3688 #-} + rule3688 = \ ((_expressionIbetaUnique) :: Int) -> + _expressionIbetaUnique + {-# INLINE rule3689 #-} + rule3689 = \ ((_expressionIcollectErrors) :: TypeErrors) -> + _expressionIcollectErrors + {-# INLINE rule3690 #-} + rule3690 = \ ((_expressionIcollectWarnings) :: Warnings) -> + _expressionIcollectWarnings + {-# INLINE rule3691 #-} + rule3691 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule3692 #-} + rule3692 = \ ((_expressionIdictionaryEnvironment) :: DictionaryEnvironment) -> + _expressionIdictionaryEnvironment + {-# INLINE rule3693 #-} + rule3693 = \ ((_expressionImatchIO) :: IO ()) -> + _expressionImatchIO + {-# INLINE rule3694 #-} + rule3694 = \ ((_expressionIuniqueChunk) :: Int) -> + _expressionIuniqueChunk + {-# INLINE rule3695 #-} + rule3695 = \ ((_expressionIuniqueSecondRound) :: Int) -> + _expressionIuniqueSecondRound + {-# INLINE rule3696 #-} + rule3696 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3697 #-} + rule3697 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3698 #-} + rule3698 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3699 #-} + rule3699 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3700 #-} + rule3700 = \ _namesInScope -> + _namesInScope + {-# INLINE rule3701 #-} + rule3701 = \ _parentTree -> + _parentTree + {-# INLINE rule3702 #-} + rule3702 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3703 #-} + rule3703 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3704 #-} + rule3704 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule3705 #-} + rule3705 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3706 #-} + rule3706 = \ ((_patternIbetaUnique) :: Int) -> + _patternIbetaUnique + {-# INLINE rule3707 #-} + rule3707 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3708 #-} + rule3708 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3709 #-} + rule3709 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3710 #-} + rule3710 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule3711 #-} + rule3711 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3712 #-} + rule3712 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3713 #-} + rule3713 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3714 #-} + rule3714 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3715 #-} + rule3715 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3716 #-} + rule3716 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3717 #-} + rule3717 = \ _parentTree -> + _parentTree + {-# INLINE rule3718 #-} + rule3718 = \ ((_patternIpatternMatchWarnings) :: [Warning]) -> + _patternIpatternMatchWarnings + {-# INLINE rule3719 #-} + rule3719 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3720 #-} + rule3720 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3721 #-} + rule3721 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3722 #-} + rule3722 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound +{-# NOINLINE sem_Statement_Empty #-} +sem_Statement_Empty :: T_Range -> T_Statement +sem_Statement_Empty arg_range_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIgeneratorBeta _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _localInfo = rule3723 _lhsImonos _self + _parentTree = rule3724 _lhsIparentTree _localInfo + _lhsOinfoTree :: InfoTree + _lhsOinfoTree = rule3725 _parentTree + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3726 () + _self = rule3727 _rangeIself + _lhsOself :: Statement + _lhsOself = rule3728 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3729 _lhsIassumptions + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3730 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3731 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3732 _lhsIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3733 _lhsIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule3734 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3735 _lhsIdictionaryEnvironment + _lhsOgeneratorBeta :: Maybe Tp + _lhsOgeneratorBeta = rule3736 _lhsIgeneratorBeta + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3737 _lhsImatchIO + _lhsOmonos :: Monos + _lhsOmonos = rule3738 _lhsImonos + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3739 _lhsInamesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3740 _lhsIpatternMatchWarnings + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3741 _lhsIunboundNames + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3742 _lhsIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3743 _lhsIuniqueSecondRound + __result_ = T_Statement_vOut154 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOgeneratorBeta _lhsOinfoTree _lhsOmatchIO _lhsOmonos _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule3723 #-} + rule3723 = \ ((_lhsImonos) :: Monos) _self -> + LocalInfo { self = UHA_Stat _self + , assignedType = Nothing + , monos = _lhsImonos + } + {-# INLINE rule3724 #-} + rule3724 = \ ((_lhsIparentTree) :: InfoTree) _localInfo -> + node _lhsIparentTree _localInfo [] + {-# INLINE rule3725 #-} + rule3725 = \ _parentTree -> + _parentTree + {-# INLINE rule3726 #-} + rule3726 = \ (_ :: ()) -> + [] + {-# INLINE rule3727 #-} + rule3727 = \ ((_rangeIself) :: Range) -> + Statement_Empty _rangeIself + {-# INLINE rule3728 #-} + rule3728 = \ _self -> + _self + {-# INLINE rule3729 #-} + rule3729 = \ ((_lhsIassumptions) :: Assumptions) -> + _lhsIassumptions + {-# INLINE rule3730 #-} + rule3730 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3731 #-} + rule3731 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3732 #-} + rule3732 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3733 #-} + rule3733 = \ ((_lhsIconstraints) :: ConstraintSet) -> + _lhsIconstraints + {-# INLINE rule3734 #-} + rule3734 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3735 #-} + rule3735 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3736 #-} + rule3736 = \ ((_lhsIgeneratorBeta) :: Maybe Tp) -> + _lhsIgeneratorBeta + {-# INLINE rule3737 #-} + rule3737 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3738 #-} + rule3738 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3739 #-} + rule3739 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3740 #-} + rule3740 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3741 #-} + rule3741 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule3742 #-} + rule3742 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3743 #-} + rule3743 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + +-- Statements -------------------------------------------------- +-- wrapper +data Inh_Statements = Inh_Statements { allPatterns_Inh_Statements :: ([((Expression, [String]), Core_TypingStrategy)]), allTypeSchemes_Inh_Statements :: (M.Map NameWithRange TpScheme), assumptions_Inh_Statements :: (Assumptions), availablePredicates_Inh_Statements :: (Predicates), betaUnique_Inh_Statements :: (Int), classEnvironment_Inh_Statements :: (ClassEnvironment), collectErrors_Inh_Statements :: (TypeErrors), collectWarnings_Inh_Statements :: (Warnings), constraints_Inh_Statements :: (ConstraintSet), counter_Inh_Statements :: (Int), currentChunk_Inh_Statements :: (Int), dictionaryEnvironment_Inh_Statements :: (DictionaryEnvironment), generatorBeta_Inh_Statements :: (Maybe Tp), importEnvironment_Inh_Statements :: (ImportEnvironment), matchIO_Inh_Statements :: (IO ()), monos_Inh_Statements :: (Monos), namesInScope_Inh_Statements :: (Names), orderedTypeSynonyms_Inh_Statements :: (OrderedTypeSynonyms), parentTree_Inh_Statements :: (InfoTree), patternMatchWarnings_Inh_Statements :: ([Warning]), substitution_Inh_Statements :: (FixpointSubstitution), typeschemeMap_Inh_Statements :: (M.Map Int (Scheme Predicates)), unboundNames_Inh_Statements :: (Names), uniqueChunk_Inh_Statements :: (Int), uniqueSecondRound_Inh_Statements :: (Int) } +data Syn_Statements = Syn_Statements { assumptions_Syn_Statements :: (Assumptions), betaUnique_Syn_Statements :: (Int), collectErrors_Syn_Statements :: (TypeErrors), collectInstances_Syn_Statements :: ([(Name, Instance)]), collectWarnings_Syn_Statements :: (Warnings), constraints_Syn_Statements :: (ConstraintSet), counter_Syn_Statements :: (Int), dictionaryEnvironment_Syn_Statements :: (DictionaryEnvironment), generatorBeta_Syn_Statements :: (Maybe Tp), infoTrees_Syn_Statements :: (InfoTrees), matchIO_Syn_Statements :: (IO ()), namesInScope_Syn_Statements :: (Names), patternMatchWarnings_Syn_Statements :: ([Warning]), self_Syn_Statements :: (Statements), unboundNames_Syn_Statements :: (Names), uniqueChunk_Syn_Statements :: (Int), uniqueSecondRound_Syn_Statements :: (Int) } +{-# INLINABLE wrap_Statements #-} +wrap_Statements :: T_Statements -> Inh_Statements -> (Syn_Statements ) +wrap_Statements (T_Statements act) (Inh_Statements _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIgeneratorBeta _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statements_vIn157 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIgeneratorBeta _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound + (T_Statements_vOut157 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOgeneratorBeta _lhsOinfoTrees _lhsOmatchIO _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) <- return (inv_Statements_s158 sem arg) + return (Syn_Statements _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOgeneratorBeta _lhsOinfoTrees _lhsOmatchIO _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound) + ) + +-- cata +{-# NOINLINE sem_Statements #-} +sem_Statements :: Statements -> T_Statements +sem_Statements list = Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list) + +-- semantic domain +newtype T_Statements = T_Statements { + attach_T_Statements :: Identity (T_Statements_s158 ) + } +newtype T_Statements_s158 = C_Statements_s158 { + inv_Statements_s158 :: (T_Statements_v157 ) + } +data T_Statements_s159 = C_Statements_s159 +type T_Statements_v157 = (T_Statements_vIn157 ) -> (T_Statements_vOut157 ) +data T_Statements_vIn157 = T_Statements_vIn157 ([((Expression, [String]), Core_TypingStrategy)]) (M.Map NameWithRange TpScheme) (Assumptions) (Predicates) (Int) (ClassEnvironment) (TypeErrors) (Warnings) (ConstraintSet) (Int) (Int) (DictionaryEnvironment) (Maybe Tp) (ImportEnvironment) (IO ()) (Monos) (Names) (OrderedTypeSynonyms) (InfoTree) ([Warning]) (FixpointSubstitution) (M.Map Int (Scheme Predicates)) (Names) (Int) (Int) +data T_Statements_vOut157 = T_Statements_vOut157 (Assumptions) (Int) (TypeErrors) ([(Name, Instance)]) (Warnings) (ConstraintSet) (Int) (DictionaryEnvironment) (Maybe Tp) (InfoTrees) (IO ()) (Names) ([Warning]) (Statements) (Names) (Int) (Int) +{-# NOINLINE sem_Statements_Cons #-} +sem_Statements_Cons :: T_Statement -> T_Statements -> T_Statements +sem_Statements_Cons arg_hd_ arg_tl_ = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIgeneratorBeta _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _hdX155 = Control.Monad.Identity.runIdentity (attach_T_Statement (arg_hd_)) + _tlX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_tl_)) + (T_Statement_vOut154 _hdIassumptions _hdIbetaUnique _hdIcollectErrors _hdIcollectInstances _hdIcollectWarnings _hdIconstraints _hdIcounter _hdIdictionaryEnvironment _hdIgeneratorBeta _hdIinfoTree _hdImatchIO _hdImonos _hdInamesInScope _hdIpatternMatchWarnings _hdIself _hdIunboundNames _hdIuniqueChunk _hdIuniqueSecondRound) = inv_Statement_s155 _hdX155 (T_Statement_vIn154 _hdOallPatterns _hdOallTypeSchemes _hdOassumptions _hdOavailablePredicates _hdObetaUnique _hdOclassEnvironment _hdOcollectErrors _hdOcollectWarnings _hdOconstraints _hdOcounter _hdOcurrentChunk _hdOdictionaryEnvironment _hdOgeneratorBeta _hdOimportEnvironment _hdOmatchIO _hdOmonos _hdOnamesInScope _hdOorderedTypeSynonyms _hdOparentTree _hdOpatternMatchWarnings _hdOsubstitution _hdOtypeschemeMap _hdOunboundNames _hdOuniqueChunk _hdOuniqueSecondRound) + (T_Statements_vOut157 _tlIassumptions _tlIbetaUnique _tlIcollectErrors _tlIcollectInstances _tlIcollectWarnings _tlIconstraints _tlIcounter _tlIdictionaryEnvironment _tlIgeneratorBeta _tlIinfoTrees _tlImatchIO _tlInamesInScope _tlIpatternMatchWarnings _tlIself _tlIunboundNames _tlIuniqueChunk _tlIuniqueSecondRound) = inv_Statements_s158 _tlX158 (T_Statements_vIn157 _tlOallPatterns _tlOallTypeSchemes _tlOassumptions _tlOavailablePredicates _tlObetaUnique _tlOclassEnvironment _tlOcollectErrors _tlOcollectWarnings _tlOconstraints _tlOcounter _tlOcurrentChunk _tlOdictionaryEnvironment _tlOgeneratorBeta _tlOimportEnvironment _tlOmatchIO _tlOmonos _tlOnamesInScope _tlOorderedTypeSynonyms _tlOparentTree _tlOpatternMatchWarnings _tlOsubstitution _tlOtypeschemeMap _tlOunboundNames _tlOuniqueChunk _tlOuniqueSecondRound) + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3744 _hdIassumptions + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3745 _hdIconstraints + _hdOassumptions = rule3746 _tlIassumptions + _hdOconstraints = rule3747 _tlIconstraints + _tlOassumptions = rule3748 _lhsIassumptions + _tlOconstraints = rule3749 _lhsIconstraints + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule3750 _hdIinfoTree _tlIinfoTrees + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3751 _hdIunboundNames + _tlOunboundNames = rule3752 _lhsIunboundNames + _hdOunboundNames = rule3753 _tlIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3754 _hdIcollectInstances _tlIcollectInstances + _self = rule3755 _hdIself _tlIself + _lhsOself :: Statements + _lhsOself = rule3756 _self + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3757 _tlIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3758 _tlIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3759 _tlIcollectWarnings + _lhsOcounter :: Int + _lhsOcounter = rule3760 _tlIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3761 _tlIdictionaryEnvironment + _lhsOgeneratorBeta :: Maybe Tp + _lhsOgeneratorBeta = rule3762 _tlIgeneratorBeta + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3763 _tlImatchIO + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3764 _tlInamesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3765 _tlIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3766 _tlIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3767 _tlIuniqueSecondRound + _hdOallPatterns = rule3768 _lhsIallPatterns + _hdOallTypeSchemes = rule3769 _lhsIallTypeSchemes + _hdOavailablePredicates = rule3770 _lhsIavailablePredicates + _hdObetaUnique = rule3771 _lhsIbetaUnique + _hdOclassEnvironment = rule3772 _lhsIclassEnvironment + _hdOcollectErrors = rule3773 _lhsIcollectErrors + _hdOcollectWarnings = rule3774 _lhsIcollectWarnings + _hdOcounter = rule3775 _lhsIcounter + _hdOcurrentChunk = rule3776 _lhsIcurrentChunk + _hdOdictionaryEnvironment = rule3777 _lhsIdictionaryEnvironment + _hdOgeneratorBeta = rule3778 _lhsIgeneratorBeta + _hdOimportEnvironment = rule3779 _lhsIimportEnvironment + _hdOmatchIO = rule3780 _lhsImatchIO + _hdOmonos = rule3781 _lhsImonos + _hdOnamesInScope = rule3782 _lhsInamesInScope + _hdOorderedTypeSynonyms = rule3783 _lhsIorderedTypeSynonyms + _hdOparentTree = rule3784 _lhsIparentTree + _hdOpatternMatchWarnings = rule3785 _lhsIpatternMatchWarnings + _hdOsubstitution = rule3786 _lhsIsubstitution + _hdOtypeschemeMap = rule3787 _lhsItypeschemeMap + _hdOuniqueChunk = rule3788 _lhsIuniqueChunk + _hdOuniqueSecondRound = rule3789 _lhsIuniqueSecondRound + _tlOallPatterns = rule3790 _lhsIallPatterns + _tlOallTypeSchemes = rule3791 _lhsIallTypeSchemes + _tlOavailablePredicates = rule3792 _lhsIavailablePredicates + _tlObetaUnique = rule3793 _hdIbetaUnique + _tlOclassEnvironment = rule3794 _lhsIclassEnvironment + _tlOcollectErrors = rule3795 _hdIcollectErrors + _tlOcollectWarnings = rule3796 _hdIcollectWarnings + _tlOcounter = rule3797 _hdIcounter + _tlOcurrentChunk = rule3798 _lhsIcurrentChunk + _tlOdictionaryEnvironment = rule3799 _hdIdictionaryEnvironment + _tlOgeneratorBeta = rule3800 _hdIgeneratorBeta + _tlOimportEnvironment = rule3801 _lhsIimportEnvironment + _tlOmatchIO = rule3802 _hdImatchIO + _tlOmonos = rule3803 _hdImonos + _tlOnamesInScope = rule3804 _hdInamesInScope + _tlOorderedTypeSynonyms = rule3805 _lhsIorderedTypeSynonyms + _tlOparentTree = rule3806 _lhsIparentTree + _tlOpatternMatchWarnings = rule3807 _hdIpatternMatchWarnings + _tlOsubstitution = rule3808 _lhsIsubstitution + _tlOtypeschemeMap = rule3809 _lhsItypeschemeMap + _tlOuniqueChunk = rule3810 _hdIuniqueChunk + _tlOuniqueSecondRound = rule3811 _hdIuniqueSecondRound + __result_ = T_Statements_vOut157 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOgeneratorBeta _lhsOinfoTrees _lhsOmatchIO _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule3744 #-} + rule3744 = \ ((_hdIassumptions) :: Assumptions) -> + _hdIassumptions + {-# INLINE rule3745 #-} + rule3745 = \ ((_hdIconstraints) :: ConstraintSet) -> + _hdIconstraints + {-# INLINE rule3746 #-} + rule3746 = \ ((_tlIassumptions) :: Assumptions) -> + _tlIassumptions + {-# INLINE rule3747 #-} + rule3747 = \ ((_tlIconstraints) :: ConstraintSet) -> + _tlIconstraints + {-# INLINE rule3748 #-} + rule3748 = \ ((_lhsIassumptions) :: Assumptions) -> + _lhsIassumptions + {-# INLINE rule3749 #-} + rule3749 = \ ((_lhsIconstraints) :: ConstraintSet) -> + _lhsIconstraints + {-# INLINE rule3750 #-} + rule3750 = \ ((_hdIinfoTree) :: InfoTree) ((_tlIinfoTrees) :: InfoTrees) -> + _hdIinfoTree : _tlIinfoTrees + {-# INLINE rule3751 #-} + rule3751 = \ ((_hdIunboundNames) :: Names) -> + _hdIunboundNames + {-# INLINE rule3752 #-} + rule3752 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule3753 #-} + rule3753 = \ ((_tlIunboundNames) :: Names) -> + _tlIunboundNames + {-# INLINE rule3754 #-} + rule3754 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule3755 #-} + rule3755 = \ ((_hdIself) :: Statement) ((_tlIself) :: Statements) -> + (:) _hdIself _tlIself + {-# INLINE rule3756 #-} + rule3756 = \ _self -> + _self + {-# INLINE rule3757 #-} + rule3757 = \ ((_tlIbetaUnique) :: Int) -> + _tlIbetaUnique + {-# INLINE rule3758 #-} + rule3758 = \ ((_tlIcollectErrors) :: TypeErrors) -> + _tlIcollectErrors + {-# INLINE rule3759 #-} + rule3759 = \ ((_tlIcollectWarnings) :: Warnings) -> + _tlIcollectWarnings + {-# INLINE rule3760 #-} + rule3760 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule3761 #-} + rule3761 = \ ((_tlIdictionaryEnvironment) :: DictionaryEnvironment) -> + _tlIdictionaryEnvironment + {-# INLINE rule3762 #-} + rule3762 = \ ((_tlIgeneratorBeta) :: Maybe Tp) -> + _tlIgeneratorBeta + {-# INLINE rule3763 #-} + rule3763 = \ ((_tlImatchIO) :: IO ()) -> + _tlImatchIO + {-# INLINE rule3764 #-} + rule3764 = \ ((_tlInamesInScope) :: Names) -> + _tlInamesInScope + {-# INLINE rule3765 #-} + rule3765 = \ ((_tlIpatternMatchWarnings) :: [Warning]) -> + _tlIpatternMatchWarnings + {-# INLINE rule3766 #-} + rule3766 = \ ((_tlIuniqueChunk) :: Int) -> + _tlIuniqueChunk + {-# INLINE rule3767 #-} + rule3767 = \ ((_tlIuniqueSecondRound) :: Int) -> + _tlIuniqueSecondRound + {-# INLINE rule3768 #-} + rule3768 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3769 #-} + rule3769 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule3770 #-} + rule3770 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3771 #-} + rule3771 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3772 #-} + rule3772 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3773 #-} + rule3773 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3774 #-} + rule3774 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3775 #-} + rule3775 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3776 #-} + rule3776 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3777 #-} + rule3777 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3778 #-} + rule3778 = \ ((_lhsIgeneratorBeta) :: Maybe Tp) -> + _lhsIgeneratorBeta + {-# INLINE rule3779 #-} + rule3779 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3780 #-} + rule3780 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3781 #-} + rule3781 = \ ((_lhsImonos) :: Monos) -> + _lhsImonos + {-# INLINE rule3782 #-} + rule3782 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3783 #-} + rule3783 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3784 #-} + rule3784 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule3785 #-} + rule3785 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3786 #-} + rule3786 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3787 #-} + rule3787 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3788 #-} + rule3788 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3789 #-} + rule3789 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + {-# INLINE rule3790 #-} + rule3790 = \ ((_lhsIallPatterns) :: [((Expression, [String]), Core_TypingStrategy)]) -> + _lhsIallPatterns + {-# INLINE rule3791 #-} + rule3791 = \ ((_lhsIallTypeSchemes) :: M.Map NameWithRange TpScheme) -> + _lhsIallTypeSchemes + {-# INLINE rule3792 #-} + rule3792 = \ ((_lhsIavailablePredicates) :: Predicates) -> + _lhsIavailablePredicates + {-# INLINE rule3793 #-} + rule3793 = \ ((_hdIbetaUnique) :: Int) -> + _hdIbetaUnique + {-# INLINE rule3794 #-} + rule3794 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule3795 #-} + rule3795 = \ ((_hdIcollectErrors) :: TypeErrors) -> + _hdIcollectErrors + {-# INLINE rule3796 #-} + rule3796 = \ ((_hdIcollectWarnings) :: Warnings) -> + _hdIcollectWarnings + {-# INLINE rule3797 #-} + rule3797 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule3798 #-} + rule3798 = \ ((_lhsIcurrentChunk) :: Int) -> + _lhsIcurrentChunk + {-# INLINE rule3799 #-} + rule3799 = \ ((_hdIdictionaryEnvironment) :: DictionaryEnvironment) -> + _hdIdictionaryEnvironment + {-# INLINE rule3800 #-} + rule3800 = \ ((_hdIgeneratorBeta) :: Maybe Tp) -> + _hdIgeneratorBeta + {-# INLINE rule3801 #-} + rule3801 = \ ((_lhsIimportEnvironment) :: ImportEnvironment) -> + _lhsIimportEnvironment + {-# INLINE rule3802 #-} + rule3802 = \ ((_hdImatchIO) :: IO ()) -> + _hdImatchIO + {-# INLINE rule3803 #-} + rule3803 = \ ((_hdImonos) :: Monos) -> + _hdImonos + {-# INLINE rule3804 #-} + rule3804 = \ ((_hdInamesInScope) :: Names) -> + _hdInamesInScope + {-# INLINE rule3805 #-} + rule3805 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule3806 #-} + rule3806 = \ ((_lhsIparentTree) :: InfoTree) -> + _lhsIparentTree + {-# INLINE rule3807 #-} + rule3807 = \ ((_hdIpatternMatchWarnings) :: [Warning]) -> + _hdIpatternMatchWarnings + {-# INLINE rule3808 #-} + rule3808 = \ ((_lhsIsubstitution) :: FixpointSubstitution) -> + _lhsIsubstitution + {-# INLINE rule3809 #-} + rule3809 = \ ((_lhsItypeschemeMap) :: M.Map Int (Scheme Predicates)) -> + _lhsItypeschemeMap + {-# INLINE rule3810 #-} + rule3810 = \ ((_hdIuniqueChunk) :: Int) -> + _hdIuniqueChunk + {-# INLINE rule3811 #-} + rule3811 = \ ((_hdIuniqueSecondRound) :: Int) -> + _hdIuniqueSecondRound +{-# NOINLINE sem_Statements_Nil #-} +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 _lhsIallPatterns _lhsIallTypeSchemes _lhsIassumptions _lhsIavailablePredicates _lhsIbetaUnique _lhsIclassEnvironment _lhsIcollectErrors _lhsIcollectWarnings _lhsIconstraints _lhsIcounter _lhsIcurrentChunk _lhsIdictionaryEnvironment _lhsIgeneratorBeta _lhsIimportEnvironment _lhsImatchIO _lhsImonos _lhsInamesInScope _lhsIorderedTypeSynonyms _lhsIparentTree _lhsIpatternMatchWarnings _lhsIsubstitution _lhsItypeschemeMap _lhsIunboundNames _lhsIuniqueChunk _lhsIuniqueSecondRound) -> ( let + _lhsOinfoTrees :: InfoTrees + _lhsOinfoTrees = rule3812 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule3813 _lhsIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule3814 () + _self = rule3815 () + _lhsOself :: Statements + _lhsOself = rule3816 _self + _lhsOassumptions :: Assumptions + _lhsOassumptions = rule3817 _lhsIassumptions + _lhsObetaUnique :: Int + _lhsObetaUnique = rule3818 _lhsIbetaUnique + _lhsOcollectErrors :: TypeErrors + _lhsOcollectErrors = rule3819 _lhsIcollectErrors + _lhsOcollectWarnings :: Warnings + _lhsOcollectWarnings = rule3820 _lhsIcollectWarnings + _lhsOconstraints :: ConstraintSet + _lhsOconstraints = rule3821 _lhsIconstraints + _lhsOcounter :: Int + _lhsOcounter = rule3822 _lhsIcounter + _lhsOdictionaryEnvironment :: DictionaryEnvironment + _lhsOdictionaryEnvironment = rule3823 _lhsIdictionaryEnvironment + _lhsOgeneratorBeta :: Maybe Tp + _lhsOgeneratorBeta = rule3824 _lhsIgeneratorBeta + _lhsOmatchIO :: IO () + _lhsOmatchIO = rule3825 _lhsImatchIO + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule3826 _lhsInamesInScope + _lhsOpatternMatchWarnings :: [Warning] + _lhsOpatternMatchWarnings = rule3827 _lhsIpatternMatchWarnings + _lhsOuniqueChunk :: Int + _lhsOuniqueChunk = rule3828 _lhsIuniqueChunk + _lhsOuniqueSecondRound :: Int + _lhsOuniqueSecondRound = rule3829 _lhsIuniqueSecondRound + __result_ = T_Statements_vOut157 _lhsOassumptions _lhsObetaUnique _lhsOcollectErrors _lhsOcollectInstances _lhsOcollectWarnings _lhsOconstraints _lhsOcounter _lhsOdictionaryEnvironment _lhsOgeneratorBeta _lhsOinfoTrees _lhsOmatchIO _lhsOnamesInScope _lhsOpatternMatchWarnings _lhsOself _lhsOunboundNames _lhsOuniqueChunk _lhsOuniqueSecondRound + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule3812 #-} + rule3812 = \ (_ :: ()) -> + [] + {-# INLINE rule3813 #-} + rule3813 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule3814 #-} + rule3814 = \ (_ :: ()) -> + [] + {-# INLINE rule3815 #-} + rule3815 = \ (_ :: ()) -> + [] + {-# INLINE rule3816 #-} + rule3816 = \ _self -> + _self + {-# INLINE rule3817 #-} + rule3817 = \ ((_lhsIassumptions) :: Assumptions) -> + _lhsIassumptions + {-# INLINE rule3818 #-} + rule3818 = \ ((_lhsIbetaUnique) :: Int) -> + _lhsIbetaUnique + {-# INLINE rule3819 #-} + rule3819 = \ ((_lhsIcollectErrors) :: TypeErrors) -> + _lhsIcollectErrors + {-# INLINE rule3820 #-} + rule3820 = \ ((_lhsIcollectWarnings) :: Warnings) -> + _lhsIcollectWarnings + {-# INLINE rule3821 #-} + rule3821 = \ ((_lhsIconstraints) :: ConstraintSet) -> + _lhsIconstraints + {-# INLINE rule3822 #-} + rule3822 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule3823 #-} + rule3823 = \ ((_lhsIdictionaryEnvironment) :: DictionaryEnvironment) -> + _lhsIdictionaryEnvironment + {-# INLINE rule3824 #-} + rule3824 = \ ((_lhsIgeneratorBeta) :: Maybe Tp) -> + _lhsIgeneratorBeta + {-# INLINE rule3825 #-} + rule3825 = \ ((_lhsImatchIO) :: IO ()) -> + _lhsImatchIO + {-# INLINE rule3826 #-} + rule3826 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule3827 #-} + rule3827 = \ ((_lhsIpatternMatchWarnings) :: [Warning]) -> + _lhsIpatternMatchWarnings + {-# INLINE rule3828 #-} + rule3828 = \ ((_lhsIuniqueChunk) :: Int) -> + _lhsIuniqueChunk + {-# INLINE rule3829 #-} + rule3829 = \ ((_lhsIuniqueSecondRound) :: Int) -> + _lhsIuniqueSecondRound + +-- Strings ----------------------------------------------------- +-- wrapper +data Inh_Strings = Inh_Strings { } +data Syn_Strings = Syn_Strings { self_Syn_Strings :: (Strings) } +{-# INLINABLE wrap_Strings #-} +wrap_Strings :: T_Strings -> Inh_Strings -> (Syn_Strings ) +wrap_Strings (T_Strings act) (Inh_Strings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Strings_vIn160 + (T_Strings_vOut160 _lhsOself) <- return (inv_Strings_s161 sem arg) + return (Syn_Strings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Strings #-} +sem_Strings :: Strings -> T_Strings +sem_Strings list = Prelude.foldr sem_Strings_Cons sem_Strings_Nil list + +-- semantic domain +newtype T_Strings = T_Strings { + attach_T_Strings :: Identity (T_Strings_s161 ) + } +newtype T_Strings_s161 = C_Strings_s161 { + inv_Strings_s161 :: (T_Strings_v160 ) + } +data T_Strings_s162 = C_Strings_s162 +type T_Strings_v160 = (T_Strings_vIn160 ) -> (T_Strings_vOut160 ) +data T_Strings_vIn160 = T_Strings_vIn160 +data T_Strings_vOut160 = T_Strings_vOut160 (Strings) +{-# NOINLINE sem_Strings_Cons #-} +sem_Strings_Cons :: (String) -> T_Strings -> T_Strings +sem_Strings_Cons arg_hd_ arg_tl_ = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _tlX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_tl_)) + (T_Strings_vOut160 _tlIself) = inv_Strings_s161 _tlX161 (T_Strings_vIn160 ) + _self = rule3830 _tlIself arg_hd_ + _lhsOself :: Strings + _lhsOself = rule3831 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule3830 #-} + rule3830 = \ ((_tlIself) :: Strings) hd_ -> + (:) hd_ _tlIself + {-# INLINE rule3831 #-} + rule3831 = \ _self -> + _self +{-# NOINLINE sem_Strings_Nil #-} +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _self = rule3832 () + _lhsOself :: Strings + _lhsOself = rule3833 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule3832 #-} + rule3832 = \ (_ :: ()) -> + [] + {-# INLINE rule3833 #-} + rule3833 = \ _self -> + _self + +-- Type -------------------------------------------------------- +-- wrapper +data Inh_Type = Inh_Type { } +data Syn_Type = Syn_Type { self_Syn_Type :: (Type) } +{-# INLINABLE wrap_Type #-} +wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) +wrap_Type (T_Type act) (Inh_Type ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Type_vIn163 + (T_Type_vOut163 _lhsOself) <- return (inv_Type_s164 sem arg) + return (Syn_Type _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Type #-} +sem_Type :: Type -> T_Type +sem_Type ( Type_Application range_ prefix_ function_ arguments_ ) = sem_Type_Application ( sem_Range range_ ) prefix_ ( sem_Type function_ ) ( sem_Types arguments_ ) +sem_Type ( Type_Variable range_ name_ ) = sem_Type_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Constructor range_ name_ ) = sem_Type_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Qualified range_ context_ type_ ) = sem_Type_Qualified ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Type type_ ) +sem_Type ( Type_Forall range_ typevariables_ type_ ) = sem_Type_Forall ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Exists range_ typevariables_ type_ ) = sem_Type_Exists ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Parenthesized range_ type_ ) = sem_Type_Parenthesized ( sem_Range range_ ) ( sem_Type type_ ) + +-- semantic domain +newtype T_Type = T_Type { + attach_T_Type :: Identity (T_Type_s164 ) + } +newtype T_Type_s164 = C_Type_s164 { + inv_Type_s164 :: (T_Type_v163 ) + } +data T_Type_s165 = C_Type_s165 +type T_Type_v163 = (T_Type_vIn163 ) -> (T_Type_vOut163 ) +data T_Type_vIn163 = T_Type_vIn163 +data T_Type_vOut163 = T_Type_vOut163 (Type) +{-# NOINLINE sem_Type_Application #-} +sem_Type_Application :: T_Range -> (Bool) -> T_Type -> T_Types -> T_Type +sem_Type_Application arg_range_ arg_prefix_ arg_function_ arg_arguments_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_function_)) + _argumentsX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _functionIself) = inv_Type_s164 _functionX164 (T_Type_vIn163 ) + (T_Types_vOut166 _argumentsIself) = inv_Types_s167 _argumentsX167 (T_Types_vIn166 ) + _self = rule3834 _argumentsIself _functionIself _rangeIself arg_prefix_ + _lhsOself :: Type + _lhsOself = rule3835 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule3834 #-} + rule3834 = \ ((_argumentsIself) :: Types) ((_functionIself) :: Type) ((_rangeIself) :: Range) prefix_ -> + Type_Application _rangeIself prefix_ _functionIself _argumentsIself + {-# INLINE rule3835 #-} + rule3835 = \ _self -> + _self +{-# NOINLINE sem_Type_Variable #-} +sem_Type_Variable :: T_Range -> T_Name -> T_Type +sem_Type_Variable arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule3836 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule3837 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule3836 #-} + rule3836 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Variable _rangeIself _nameIself + {-# INLINE rule3837 #-} + rule3837 = \ _self -> + _self +{-# NOINLINE sem_Type_Constructor #-} +sem_Type_Constructor :: T_Range -> T_Name -> T_Type +sem_Type_Constructor arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule3838 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule3839 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule3838 #-} + rule3838 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Constructor _rangeIself _nameIself + {-# INLINE rule3839 #-} + rule3839 = \ _self -> + _self +{-# NOINLINE sem_Type_Qualified #-} +sem_Type_Qualified :: T_Range -> T_ContextItems -> T_Type -> T_Type +sem_Type_Qualified arg_range_ arg_context_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule3840 _contextIself _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule3841 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule3840 #-} + rule3840 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Qualified _rangeIself _contextIself _typeIself + {-# INLINE rule3841 #-} + rule3841 = \ _self -> + _self +{-# NOINLINE sem_Type_Forall #-} +sem_Type_Forall :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Forall arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule3842 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule3843 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule3842 #-} + rule3842 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Forall _rangeIself _typevariablesIself _typeIself + {-# INLINE rule3843 #-} + rule3843 = \ _self -> + _self +{-# NOINLINE sem_Type_Exists #-} +sem_Type_Exists :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Exists arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule3844 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule3845 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule3844 #-} + rule3844 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Exists _rangeIself _typevariablesIself _typeIself + {-# INLINE rule3845 #-} + rule3845 = \ _self -> + _self +{-# NOINLINE sem_Type_Parenthesized #-} +sem_Type_Parenthesized :: T_Range -> T_Type -> T_Type +sem_Type_Parenthesized arg_range_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule3846 _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule3847 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule3846 #-} + rule3846 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Parenthesized _rangeIself _typeIself + {-# INLINE rule3847 #-} + rule3847 = \ _self -> + _self + +-- Types ------------------------------------------------------- +-- wrapper +data Inh_Types = Inh_Types { } +data Syn_Types = Syn_Types { self_Syn_Types :: (Types) } +{-# INLINABLE wrap_Types #-} +wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) +wrap_Types (T_Types act) (Inh_Types ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Types_vIn166 + (T_Types_vOut166 _lhsOself) <- return (inv_Types_s167 sem arg) + return (Syn_Types _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Types #-} +sem_Types :: Types -> T_Types +sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) + +-- semantic domain +newtype T_Types = T_Types { + attach_T_Types :: Identity (T_Types_s167 ) + } +newtype T_Types_s167 = C_Types_s167 { + inv_Types_s167 :: (T_Types_v166 ) + } +data T_Types_s168 = C_Types_s168 +type T_Types_v166 = (T_Types_vIn166 ) -> (T_Types_vOut166 ) +data T_Types_vIn166 = T_Types_vIn166 +data T_Types_vOut166 = T_Types_vOut166 (Types) +{-# NOINLINE sem_Types_Cons #-} +sem_Types_Cons :: T_Type -> T_Types -> T_Types +sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _hdX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) + _tlX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) + (T_Type_vOut163 _hdIself) = inv_Type_s164 _hdX164 (T_Type_vIn163 ) + (T_Types_vOut166 _tlIself) = inv_Types_s167 _tlX167 (T_Types_vIn166 ) + _self = rule3848 _hdIself _tlIself + _lhsOself :: Types + _lhsOself = rule3849 _self + __result_ = T_Types_vOut166 _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule3848 #-} + rule3848 = \ ((_hdIself) :: Type) ((_tlIself) :: Types) -> + (:) _hdIself _tlIself + {-# INLINE rule3849 #-} + rule3849 = \ _self -> + _self +{-# NOINLINE sem_Types_Nil #-} +sem_Types_Nil :: T_Types +sem_Types_Nil = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _self = rule3850 () + _lhsOself :: Types + _lhsOself = rule3851 _self + __result_ = T_Types_vOut166 _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule3850 #-} + rule3850 = \ (_ :: ()) -> + [] + {-# INLINE rule3851 #-} + rule3851 = \ _self -> + _self diff --git a/src/Helium/StaticAnalysis/Messages/HeliumMessages.hs b/src/Helium/StaticAnalysis/Messages/HeliumMessages.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Messages/HeliumMessages.hs @@ -0,0 +1,201 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| Module : HeliumMessages + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Defines how the (error) messages should be reported by the Helium compiler. + (For instance, one could define another layout, or produce XML-like output). +-} + +module Helium.StaticAnalysis.Messages.HeliumMessages where + + +import Helium.StaticAnalysis.Messages.Messages +import Top.Types +import qualified Text.PrettyPrint.Leijen as PPrint +import qualified Helium.Utils.OneLiner as OneLiner +import Data.List +import Helium.StaticAnalysis.Miscellaneous.TypesToAlignedDocs (qualifiedTypesToAlignedDocs) +import Helium.Syntax.UHA_Range (isImportRange, showRanges) +import Data.Char (isSpace) + +---------------------------------------------------------- +-- message parameters + +lineLength :: Int +lineLength = 80 + +tableWidthLeft :: Int +tableWidthLeft = 16 + +tablePrefix :: String +tablePrefix = " " + +tableSeparator :: String +tableSeparator = " : " + +splitStringMargin :: Int +splitStringMargin = 15 + +---------------------------------------------------------- + +tableWidthRight :: Int +tableWidthRight = lineLength - tableWidthLeft - length (tablePrefix ++ tableSeparator) + +---------------------------------------------------------- + +instance Show MessageLine where + show messageLine = + case prepareTypesAndTypeSchemes messageLine of + MessageOneLiner m -> show m++"\n" + MessageTable tab -> showTable tab + MessageHints pre ms -> showHints pre ms + +instance Show MessageBlock where + show (MessageString s ) = s + show (MessageRange r ) = show r + show (MessageType tp ) = show tp + show (MessagePredicate p ) = show p + show (MessageOneLineTree t) = OneLiner.showOneLine tableWidthRight t + show (MessageCompose ms ) = concatMap show ms + +sortAndShowMessages :: HasMessage a => [a] -> String +sortAndShowMessages = concatMap showMessage . sortMessages + +showMessage :: HasMessage message => message -> String +showMessage x = + let rangePart = + case filter (not . isImportRange) (getRanges x) of + [] -> MessageString "" + xs -> MessageString (showRanges xs ++ ": ") + messageWithRange = + case getMessage x of + MessageOneLiner m:rest -> MessageOneLiner (MessageCompose [rangePart, m]) : rest + xs -> MessageOneLiner rangePart : xs + in concatMap show messageWithRange + +showHints :: String -> MessageBlocks -> String +showHints pre ms = + let firstPrefix = " " ++ pre ++ ": " + restPrefix = replicate (4 + length pre) ' ' + prefixes = firstPrefix : repeat restPrefix + width = lineLength - length firstPrefix + combine = intercalate ('\n' : restPrefix) + in unlines . zipWith (++) prefixes . map (combine . splitString width . show) $ ms + +showTable :: [(Bool, MessageBlock, MessageBlock)] -> String +showTable = + let showTuple (indentBlock, leftBlock, rightBlock) = + let -- some helper functions + leftWidth = tableWidthLeft - (if indentBlock then 2 else 0) + concatFour a b c d = a ++ b ++ c ++ d + makeOfLength i s = take i (s ++ repeat ' ') + linesOfLength i = repeat (replicate i ' ') + -- lines + leftLines = splitString leftWidth (show leftBlock) + rightLines = splitString tableWidthRight (show rightBlock) + nrOfLines = length leftLines `max` length rightLines + -- the four columns + indentColumn = if indentBlock + then linesOfLength (length tablePrefix + 2) + else tablePrefix : linesOfLength (length tablePrefix) + leftColumn = map (makeOfLength leftWidth) leftLines ++ linesOfLength leftWidth + seperatorColumn = tableSeparator : linesOfLength (length tableSeparator) + rightColumn = rightLines ++ linesOfLength tableWidthRight + in unlines (take nrOfLines (zipWith4 concatFour indentColumn leftColumn seperatorColumn rightColumn)) + in concatMap showTuple . renderTypesInRight + +-- if two types or type schemes follow each other in a table (on the right-hand side) +-- then the two types are rendered in a special way. +renderTypesInRight :: [(Bool, MessageBlock, MessageBlock)] -> [(Bool, MessageBlock, MessageBlock)] +renderTypesInRight table = + case table of + hd@(q1, l1, r1) : tl@((q2, l2, r2) : rest) + -> case (maybeQType r1, maybeQType r2) of + (Just tp1, Just tp2) -> + let [doc1, doc2] = qualifiedTypesToAlignedDocs [tp1, tp2] + render = flip PPrint.displayS [] . PPrint.renderPretty 1.0 tableWidthRight + in (q1, l1, MessageType (toTpScheme (TCon (render doc1)))) + : (q2, l2, MessageType (toTpScheme (TCon (render doc2)))) + : renderTypesInRight rest + _ -> hd : renderTypesInRight tl + _ -> table + + where maybeQType :: MessageBlock -> Maybe QType + maybeQType (MessageType qtype) = Just (unquantify qtype) -- unsafe? + maybeQType _ = Nothing + +-- make sure that a string does not exceed a certain width. +-- Two extra features: +-- - treat '\n' in the proper way. +-- (Be careful here: an enter in a string or a character does not +-- make a new line) +-- - try not to break words. +splitString :: Int -> String -> [String] +splitString width = concatMap f . lines + where f string | length string <= width + = [string] + | otherwise + = let lastSpace = last . (width:) . map fst . filter predicate + . zip [0..] . take width $ string + predicate (pos, char) = isSpace char && pos >= width - splitStringMargin + (begin, rest) = splitAt lastSpace string + in begin : f (dropWhile isSpace rest) + +-- Prepare the types and type schemes in a messageline to be shown. +-- +-- type schemes: +-- * responsible for their own type variables +-- * monomorphic type variables are frozen, that is, replaced by _1, _2, etc. +-- types: +-- * use a, b, c for type variables +-- * use the type variables consistent over all types +-- (for instance, all v5 are mapped to a 'c') +prepareTypesAndTypeSchemes :: MessageLine -> MessageLine +prepareTypesAndTypeSchemes messageLine = newMessageLine + where + (result, _, names) = replaceTypeSchemes messageLine + newMessageLine = giveTypeVariableIdentifiers result + + --step 1 + replaceTypeSchemes :: MessageLine -> (MessageLine, Int, [String]) + replaceTypeSchemes messageLine' = + let unique = nextFTV messageLine' + in case messageLine' of + MessageOneLiner mb -> let (r, i, ns) = f_MessageBlock unique mb + in (MessageOneLiner r, i, ns) + MessageTable tab -> let (r, i, ns) = f_Table unique tab + in (MessageTable r, i, ns) + MessageHints s mbs -> let (r, i, ns) = f_MessageBlocks unique mbs + in (MessageHints s r, i, ns) + + --step 2 + giveTypeVariableIdentifiers :: MessageLine -> MessageLine + giveTypeVariableIdentifiers ml = + let sub = listToSubstitution (zip (ftv ml) [ TCon s | s <- variableList, s `notElem` names]) + in sub |-> ml + + f_Table :: Int -> [(Bool, MessageBlock, MessageBlock)] -> ([(Bool, MessageBlock, MessageBlock)], Int, [String]) + f_Table i [] = ([], i, []) + f_Table i ((q, a, b):xs) = let (r1, i1, ns1) = f_MessageBlock i a + (r2, i2, ns2) = f_MessageBlock i1 b + (r3, i3, ns3) = f_Table i2 xs + in ((q, r1, r2):r3, i3, ns1++ns2++ns3) + + f_MessageBlocks :: Int -> [MessageBlock] -> ([MessageBlock], Int, [String]) + f_MessageBlocks i [] = ([], i, []) + f_MessageBlocks i (x:xs) = let (r1, i1, ns1) = f_MessageBlock i x + (r2, i2, ns2) = f_MessageBlocks i1 xs + in (r1:r2, i2, ns1++ns2) + + f_MessageBlock :: Int -> MessageBlock -> (MessageBlock, Int, [String]) + f_MessageBlock unique messageBlock = + case messageBlock of + MessageCompose mbs -> let (r, i, ns) = f_MessageBlocks unique mbs + in (MessageCompose r, i, ns) + MessageType ts -> let (unique', ps, its) = instantiateWithNameMap unique ts + in (MessageType (toTpScheme (ps .=>. its)), unique', constantsInType its) + _ -> (messageBlock, unique, []) diff --git a/src/Helium/StaticAnalysis/Messages/Information.hs b/src/Helium/StaticAnalysis/Messages/Information.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Messages/Information.hs @@ -0,0 +1,156 @@ +module Helium.StaticAnalysis.Messages.Information where + +import Top.Types +import Helium.Main.CompileUtils +import Helium.Parser.OperatorTable +import Helium.StaticAnalysis.Messages.Messages hiding (Constructor) +import Helium.Syntax.UHA_Syntax hiding (Fixity) +import Helium.Syntax.UHA_Utils +import Helium.Syntax.UHA_Range +import qualified Data.Map as M + +type Fixity = (Int, Assoc) + +data InfoItem + = Function Name TpScheme (Maybe Fixity) + | ValueConstructor Name TpScheme (Maybe Fixity) + | TypeSynonym Name Int (Tps -> Tp) + | DataTypeConstructor Name Int [(Name, TpScheme)] + | TypeClass String Class + | NotDefined String + +showInformation :: Bool -> [Option] -> ImportEnvironment -> IO () +showInformation reportNotFound options importEnv = + let items = concat [ makeInfoItem name | Information name <- options ] + in showMessages items + + where + makeInfoItem :: String -> [InfoItem] + makeInfoItem string = + let + notFound items = if null items && reportNotFound then [ NotDefined string ] else items + + function = + case lookupWithKey (nameFromString string) (typeEnvironment importEnv) of + Just (name, scheme) -> + [Function name scheme (M.lookup name (operatorTable importEnv))] + Nothing -> [] + + constructor = + case lookupWithKey (nameFromString string) (valueConstructors importEnv) of + Just (name, scheme) -> + [ValueConstructor name scheme (M.lookup name (operatorTable importEnv))] + Nothing -> [] + + synonyms = + case lookupWithKey (nameFromString string) (typeSynonyms importEnv) of + Just (name, (i, f)) -> + [TypeSynonym name i f] + Nothing -> [] + + datatypeconstructor = + case lookupWithKey (nameFromString string) (typeConstructors importEnv) of + Just (name, i) | not (M.member name (typeSynonyms importEnv)) + -> [DataTypeConstructor name i (findValueConstructors name importEnv)] + _ -> [] + + typeclass = + case M.lookup string standardClasses of + Just cl -> [TypeClass string cl] + Nothing -> [] + in + notFound (function ++ constructor ++ synonyms ++ datatypeconstructor ++ typeclass) + +itemDescription :: InfoItem -> [String] +itemDescription infoItem = + case infoItem of + + Function name ts _ -> + let tp = unqualify (unquantify ts) + start | isOperatorName name = "operator" + | isFunctionType tp = "function" + | otherwise = "value" + in [ "-- " ++ start ++ " " ++ show name ++ ", " ++ definedOrImported (getNameRange name) ] + + ValueConstructor name _ _ -> + [ "-- value constructor " ++ show name ++ ", " ++ definedOrImported (getNameRange name) ] + + TypeSynonym name _ _ -> + [ "-- type synonym " ++ show name ++ ", " ++ definedOrImported (getNameRange name) ] + + DataTypeConstructor name _ _ -> + [ "-- type constructor " ++ show name ++ ", " ++ definedOrImported (getNameRange name) ] + + TypeClass s _ -> + [ " -- type class " ++ s ] + + NotDefined _ -> + [ ] + +definedOrImported :: Range -> String +definedOrImported range + | isImportRange range = "imported from " ++ show range + | otherwise = "defined at " ++ show range + +showMaybeFixity :: Name -> Maybe Fixity -> MessageBlocks +showMaybeFixity name = + let f (prio', associativity) = show associativity ++ " " ++ show prio' ++ " " ++ showNameAsOperator name + in maybe [] ((:[]) . MessageString . f) + +instance HasMessage InfoItem where + + getMessage infoItem = + map (MessageOneLiner . MessageString) (itemDescription infoItem) + ++ + case infoItem of + + Function name ts mFixity -> + map MessageOneLiner + ( MessageString (showNameAsVariable name ++ " :: " ++ show ts) + : showMaybeFixity name mFixity + ) + + ValueConstructor name ts mFixity -> + map MessageOneLiner + ( MessageString (showNameAsVariable name ++ " :: " ++ show ts) + : showMaybeFixity name mFixity + ) + + TypeSynonym name i f -> + let tps = take i [ TCon [c] | c <- ['a'..] ] + text = unwords ("type" : show name : map show tps ++ ["=", show (f tps)]) + in [ MessageOneLiner (MessageString text) ] + + DataTypeConstructor name i cons -> + let tps = take i [ TCon [c] | c <- ['a'..] ] + text = unwords ("data" : show name : map show tps) + related = let f (name', ts) = " " ++ showNameAsVariable name' ++ " :: " ++ show ts + in if null cons then [] else " -- value constructors" : map f cons + in map MessageOneLiner + ( MessageString text + : map MessageString related + ) + + TypeClass name (supers, theInstances) -> + let f s = s ++ " a" + text = "class " ++ showContextSimple (map f supers) ++ f name + related = let ef (p, ps) = " instance " ++ show (generalizeAll (ps .=>. p)) + in if null theInstances then [] else " -- instances" : map ef theInstances + in map MessageOneLiner + ( MessageString text + : map MessageString related + ) + + NotDefined name -> + map MessageOneLiner + [ MessageString (show name ++ " not defined") ] + +findValueConstructors :: Name -> ImportEnvironment -> [(Name, TpScheme)] +findValueConstructors name = + let test = isName . fst . leftSpine . snd . functionSpine . unqualify . unquantify + isName (TCon s) = s == show name + isName _ = False + in M.assocs . M.filter test . valueConstructors + +lookupWithKey :: Ord key => key -> M.Map key a -> Maybe (key, a) +lookupWithKey key = M.lookup key . M.mapWithKey (,) diff --git a/src/Helium/StaticAnalysis/Messages/KindErrors.hs b/src/Helium/StaticAnalysis/Messages/KindErrors.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Messages/KindErrors.hs @@ -0,0 +1,81 @@ +{-| Module : KindErrors + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Error messages repoted by kind inference. +-} + +module Helium.StaticAnalysis.Messages.KindErrors where + +import Top.Types +import Top.Constraint.Information(TypeConstraintInfo(..),PolyTypeConstraintInfo(..)) + +import Helium.Syntax.UHA_Syntax (Range, Type) +import Text.PrettyPrint.Leijen (Doc) +import Helium.StaticAnalysis.Messages.Messages +import Data.List (union) +import qualified Helium.Syntax.UHA_Pretty as PP +-- import qualified Text.PrettyPrint.Leijen as PPrint + +type KindErrors = [KindError] +data KindError = MustBeStar Range String Doc Kind + | KindApplication Range Doc Doc Kind Kind + +instance TypeConstraintInfo KindError +instance PolyTypeConstraintInfo KindError + +-- two "smart" constructors +mustBeStar :: Range -> String -> Type -> (Kind, Kind) -> KindError +mustBeStar range location uhaType (kind, _) = + MustBeStar range location (PP.text_Syn_Type $ PP.wrap_Type (PP.sem_Type uhaType) PP.Inh_Type) kind + +kindApplication :: Range -> Type -> Type -> (Kind, Kind) -> KindError +kindApplication range uhaType1 uhaType2 (kind1, kind2) = + KindApplication range (PP.text_Syn_Type $ PP.wrap_Type (PP.sem_Type uhaType1) PP.Inh_Type) (PP.text_Syn_Type $ PP.wrap_Type (PP.sem_Type uhaType2) PP.Inh_Type) kind1 kind2 + +instance Show KindError where + show _ = "" + +instance HasMessage KindError where + + getRanges kindError = + case kindError of + MustBeStar r _ _ _ -> [r] + KindApplication r _ _ _ _ -> [r] + + getMessage kindError = + case kindError of + MustBeStar _ s d k -> + [ MessageOneLiner (MessageString $ "Illegal type in "++s) + , MessageTable + [ "type" <:> MessageString (show d) + , "kind" >:> MessageType (toTpScheme k) + , "expected kind" >:> MessageType (toTpScheme star) + ] + ] + + KindApplication _ d1 d2 k1 k2 -> + [ MessageOneLiner (MessageString "Illegal type in type application") + , MessageTable + [ "type" <:> MessageString (show d1) + , "type constructor" <:> MessageString (show d2) + , "kind" >:> MessageType (toTpScheme k1) + , "does not match" >:> MessageType (toTpScheme k2) + ] + ] + +instance Substitutable KindError where + + sub |-> kindError = + case kindError of + MustBeStar r s d k -> MustBeStar r s d (sub |-> k) + KindApplication r d1 d2 k1 k2 -> KindApplication r d1 d2 (sub |-> k1) (sub |-> k2) + + ftv kindError = + case kindError of + MustBeStar _ _ _ k -> ftv k + KindApplication _ _ _ k1 k2 -> ftv k1 `union` ftv k2 + diff --git a/src/Helium/StaticAnalysis/Messages/Messages.hs b/src/Helium/StaticAnalysis/Messages/Messages.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Messages/Messages.hs @@ -0,0 +1,184 @@ +{-| Module : Messages + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Datatype to represent error messages. One abstraction is the datatype + MessageBlock, which contains (atomic) pieces of information that are + reported in the error messages such as types, ranges and code fragments. +-} + +module Helium.StaticAnalysis.Messages.Messages where + +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Range +import Helium.Syntax.UHA_Utils () +import Top.Types + +import Helium.Utils.OneLiner +import Helium.Utils.Similarity (similar) +import Helium.Utils.Utils (internalError) +import Data.List (sortBy, partition) +import Data.Char (toUpper) +import Data.Function + +type Message = [MessageLine] + +data MessageLine = MessageOneLiner MessageBlock + | MessageTable [(Bool, MessageBlock, MessageBlock)] -- Bool: indented or not + | MessageHints String MessageBlocks + +type MessageBlocks = [MessageBlock] +data MessageBlock = MessageString String + | MessageRange Range + | MessageType TpScheme + | MessagePredicate Predicate + | MessageOneLineTree OneLineTree + | MessageCompose MessageBlocks + +class HasMessage a where + getRanges :: a -> [Range] + getMessage :: a -> Message + + -- default definitions + getRanges _ = [] + +instance (HasMessage a, HasMessage b) => HasMessage (Either a b) where + getRanges = either getRanges getRanges + getMessage = either getMessage getMessage + +instance Substitutable MessageLine where + + sub |-> ml = case ml of + MessageOneLiner mb -> MessageOneLiner (sub |-> mb) + MessageTable table -> MessageTable [ (b, sub |-> mb1, sub |-> mb2) | (b, mb1, mb2) <- table ] + MessageHints s mbs -> MessageHints s (sub |-> mbs) + + ftv ml = case ml of + MessageOneLiner mb -> ftv mb + MessageTable table -> ftv [ [mb1, mb2] | (_, mb1, mb2) <- table ] + MessageHints _ mbs -> ftv mbs + +instance Substitutable MessageBlock where + + sub |-> mb = case mb of + MessageType tp -> MessageType (sub |-> tp) + MessagePredicate p -> MessagePredicate (sub |-> p) + MessageCompose mbs -> MessageCompose (sub |-> mbs) + _ -> mb + + ftv mb = case mb of + MessageType tp -> ftv tp + MessagePredicate p -> ftv p + MessageCompose mbs -> ftv mbs + _ -> [] + +------------------------------------------------------------- +-- Smart row constructors for tables + +infixl 1 <:>, >:> -- very low priority + +-- do not indent +(<:>) :: String -> MessageBlock -> (Bool, MessageBlock, MessageBlock) +s <:> mb = (False, MessageString s, mb) + +-- indented row +(>:>) :: String -> MessageBlock -> (Bool, MessageBlock, MessageBlock) +s >:> mb = (True, MessageString s, mb) + +------------------------------------------------------------- +-- Misc + +data Entity = TypeSignature + | TypeVariable + | TypeConstructor + | Definition + | Constructor + | Variable + | Import + | ExportVariable + | ExportModule + | ExportConstructor + | ExportTypeConstructor + | Fixity + deriving Eq + +sortMessages :: HasMessage a => [a] -> [a] +sortMessages = let f x y = compare (getRanges x) (getRanges y) + in sortBy f + +sortNamesByRange :: Names -> Names +sortNamesByRange names = + let tupleList = [ (name, getNameRange name) | name <- names ] + (xs,ys) = partition (isImportRange . snd) tupleList + in map fst (sortBy (compare `on` snd ) ys ++ xs) + +-- The first argument indicates whether numbers up to ten should be +-- printed "verbose" +ordinal :: Bool -> Int -> String +ordinal b i + | i >= 1 && i <= 10 && b = table !! (i - 1) + | i >= 0 = show i ++ extension i + | otherwise = internalError "Messages.hs" + "ordinal" + "can't show numbers smaller than 0" + where + table = + [ "first", "second", "third", "fourth", "fifth", "sixth","seventh" + , "eighth", "ninth", "tenth" + ] + extension j + | j > 3 && i < 20 = "th" + | j `mod` 10 == 1 = "st" + | j `mod` 10 == 2 = "nd" + | j `mod` 10 == 3 = "rd" + | otherwise = "th" + +showNumber :: Int -> String +showNumber i | i <= 10 && i >=0 = list !! i + | otherwise = show i + where list = [ "zero", "one", "two", "three", "four", "five" + , "six", "seven", "eight", "nine", "ten" + ] + +prettyOrList :: [String] -> String +prettyOrList [] = "" +prettyOrList [s] = s +prettyOrList xs = foldr1 (\x y -> x++", "++y) (init xs) ++ " or "++last xs + +prettyAndList :: [String] -> String +prettyAndList [] = "" +prettyAndList [s] = s +prettyAndList xs = foldr1 (\x y -> x++", "++y) (init xs) ++ " and "++last xs + +prettyNumberOfParameters :: Int -> String +prettyNumberOfParameters 0 = "no parameters" +prettyNumberOfParameters 1 = "1 parameter" +prettyNumberOfParameters n = show n++" parameters" + +capitalize :: String -> String +capitalize [] = [] +capitalize (x:xs) = toUpper x : xs + +findSimilar :: Name -> Names -> Names +findSimilar n = filter (\x -> show n `similar` show x) + +instance Show Entity where + show entity = + case entity of + TypeSignature -> "type signature" + TypeVariable -> "type variable" + TypeConstructor -> "type constructor" + Definition -> "definition" + Constructor -> "constructor" + Variable -> "variable" + Import -> "import" + ExportVariable -> "exported variable" + ExportModule -> "exported module" + ExportConstructor + -> "exported constructor" + ExportTypeConstructor + -> "exported type constructor" + Fixity -> "infix declaration" diff --git a/src/Helium/StaticAnalysis/Messages/StaticErrors.hs b/src/Helium/StaticAnalysis/Messages/StaticErrors.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Messages/StaticErrors.hs @@ -0,0 +1,298 @@ +{-| Module : StaticErrors + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Collection of static error messages. +-} + +module Helium.StaticAnalysis.Messages.StaticErrors where + + +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Range +import Helium.StaticAnalysis.Messages.Messages +import Data.List (nub, intersperse, sort, partition) +import Data.Maybe +import Helium.Utils.Utils (commaList, internalError, maxInt) + +import Top.Types + +------------------------------------------------------------- +-- (Static) Errors + +type Errors = [Error] +data Error = NoFunDef Entity Name {-names in scope-}Names + | Undefined Entity Name {-names in scope-}Names {-similar name in wrong name-space hint-}[String] {- hints -} + | Duplicated Entity Names + | LastStatementNotExpr Range + | WrongFileName {-file name-}String {-module name-}String Range {- of module name -} + | TypeVarApplication Name + | ArityMismatch {-type constructor-}Entity Name {-verwacht aantal parameters-}Int {-aangetroffen aantal parameters-}Int + | DefArityMismatch Name (Maybe Int) {- verwacht -} Range + | RecursiveTypeSynonyms Names + | PatternDefinesNoVars Range + | IntLiteralTooBig Range String + | OverloadingDisabled Range + | OverloadedRestrPat Name + | WrongOverloadingFlag Bool{- flag? -} + | AmbiguousContext Name + | UnknownClass Name + | NonDerivableClass Name + | CannotDerive Name Tps + | TupleTooBig Range + +instance HasMessage Error where + getMessage x = let (oneliner, hints) = showError x + in [MessageOneLiner oneliner, MessageHints "Hint" hints] + getRanges anError = case anError of + + NoFunDef _ name _ -> [getNameRange name] + Undefined _ name _ _ -> [getNameRange name] + Duplicated _ names -> sortRanges (map getNameRange names) + LastStatementNotExpr range -> [range] + WrongFileName _ _ range -> [range] + TypeVarApplication name -> [getNameRange name] + ArityMismatch _ name _ _ -> [getNameRange name] + DefArityMismatch _ _ range -> [range] + RecursiveTypeSynonyms names -> sortRanges (map getNameRange names) + PatternDefinesNoVars range -> [range] + IntLiteralTooBig range _ -> [range] + OverloadingDisabled range -> [range] + OverloadedRestrPat name -> [getNameRange name] + WrongOverloadingFlag _ -> [emptyRange] + AmbiguousContext name -> [getNameRange name] + UnknownClass name -> [getNameRange name] + NonDerivableClass name -> [getNameRange name] + CannotDerive name _ -> [getNameRange name] + TupleTooBig r -> [r] + +sensiblySimilar :: Name -> Names -> [Name] +sensiblySimilar name inScope = + let + similars = nub (findSimilar name inScope) + in + if length similars <= 3 then -- 3 is the magic number + similars + else + [] + +showError :: Error -> (MessageBlock {- oneliner -}, MessageBlocks {- hints -}) +showError anError = case anError of + + NoFunDef TypeSignature name inScope -> + ( MessageString ("Type signature for " ++ show (show name) ++ " without a definition ") + , [ MessageString ("Did you mean "++prettyOrList (map (show . show) xs)++" ?") + | let xs = sensiblySimilar name inScope, not (null xs) + ] + ) + + NoFunDef Fixity name inScope -> + ( MessageString ("Infix declaration for " ++ show (show name) ++ " without a definition ") + , [ MessageString ("Did you mean "++prettyOrList (map (show . show) xs)++" ?") + | let xs = sensiblySimilar name inScope, not (null xs) + ] + ) + + Undefined entity name inScope hints -> + ( MessageString ("Undefined " ++ show entity ++ " " ++ show (show name)) + , map MessageString hints + ++ + [ MessageString ("Did you mean " ++ prettyOrList (map (show . show) xs) ++ " ?") + | let xs = sensiblySimilar name inScope, not (null xs) + ] + ) + + Duplicated entity names + | all isImportRange nameRanges -> + ( MessageString ( + capitalize (show entity) ++ " " ++ + (show . show . head) names ++ + " imported from multiple modules: " ++ + commaList (map (snd.fromJust.modulesFromImportRange) nameRanges)), []) + + | any isImportRange nameRanges -> + let + (importRanges, _) = partition isImportRange nameRanges + plural = if length importRanges > 1 then "s" else "" + in + ( MessageString ( + capitalize (show entity) ++ " " ++ (show.show.head) names ++ + " clashes with definition" ++ plural ++ + " in imported module" ++ plural ++ " " ++ + commaList [ snd (fromJust (modulesFromImportRange importRange)) + | importRange <- importRanges + ]), []) + + | otherwise -> + ( MessageString ("Duplicated " ++ show entity ++ " " ++ (show . show . head) names), []) + + where +{- fromRanges = [ if isImportRange range then + Range_Range position position + else + range + | range <- nameRanges + , let position = getRangeEnd range + ] -} + nameRanges = sort (map getNameRange names) + + LastStatementNotExpr _ -> + ( MessageString "Last generator in do {...} must be an expression ", []) + + TypeVarApplication name -> + ( MessageString ("Type variable " ++ show (show name) ++ " cannot be applied to another type"), []) + + ArityMismatch entity name expected actual -> + ( MessageString ( capitalize (show entity) ++ " " ++show (show name) ++ + " should have " ++ prettyNumberOfParameters expected ++ + ", but has " ++ if actual == 0 then "none" else show actual), []) + + RecursiveTypeSynonyms [string] -> + ( MessageString ("Recursive type synonym " ++ show (show string)) + , [ MessageString "Use \"data\" to write a recursive data type" ] + ) + + RecursiveTypeSynonyms strings -> + ( MessageString ("Recursive type synonyms " ++ + prettyAndList (map (show . show) (sortNamesByRange strings))) + , [] + ) + + DefArityMismatch name maybeExpected _ -> + ( MessageString ("Arity mismatch in function bindings for " ++ show (show name)) + , [ MessageString (show arity ++ " parameters in most of the clauses") + | Just arity <- [maybeExpected] + ] + ) + + PatternDefinesNoVars _ -> + ( MessageString "Left hand side pattern defines no variables", []) + + WrongFileName fileName moduleName _ -> + ( MessageString ("The file name " ++ show fileName ++ " doesn't match the module name " ++ show moduleName), []) + + IntLiteralTooBig _ value -> + ( MessageString ("Integer literal (" ++ value ++ ") too big") + , [ MessageString $ "Maximum is " ++ show maxInt ] + ) + + OverloadedRestrPat name -> + ( MessageString ("Illegal overloaded type signature for " ++ show (show name)) + , [MessageString "Only functions and simple patterns can have an overloaded type"] + ) + + OverloadingDisabled _ -> + ( MessageString "Cannot handle contexts when overloading is disabled" + , [] + ) + + WrongOverloadingFlag False -> + ( MessageString "Using overloaded Prelude while overloading is not enabled" + , [MessageString "Compile with --overloading, or use the simple Prelude"] + ) + + WrongOverloadingFlag True -> + ( MessageString "Using simple Prelude while overloading is enabled" + , [MessageString "Compile without --overloading, or use the overloaded Prelude"] + ) + + AmbiguousContext name -> + ( MessageString ("Type variable " ++ show (show name) ++ " appears in the context but not in the type") + , [] + ) + + UnknownClass name -> + ( MessageString ("Unknown class " ++ show (show name) ++ " (Helium only supports Eq, Ord, Num, Show, Enum)") + , [] + ) + + NonDerivableClass name -> + ( MessageString ("Cannot derive class " ++ show (show name)) + , [MessageString "Only Show and Eq instances can be derived"] + ) + + CannotDerive name tps -> + ( MessageString ("Cannot derive instance for class " ++ show (show name)) + , let msg = MessageCompose (intersperse (MessageString ", ") (map (MessageType . toTpScheme) tps)) + + in [ MessageCompose + [ MessageString "There " + , MessageString ( if length tps == 1 then "is " else "are ") + , MessageString ("no " ++ show name ++ " instance") + , MessageString ( if length tps == 1 then " " else "s ") + , MessageString "for " + , msg + ] + ] + ) + + TupleTooBig _ -> + ( MessageString "Tuples can have up to 10 elements" + , [] + ) + + _ -> internalError "StaticErrors.hs" "showError" "unknown type of Error" + +makeUndefined :: Entity -> Names -> Names -> [Error] +makeUndefined entity names inScope = [ Undefined entity name inScope [] | name <- names ] + +makeDuplicated :: Entity -> [Names] -> [Error] +makeDuplicated entity nameslist = [ Duplicated entity names | names <- nameslist ] + +undefinedConstructorInExpr :: Name -> Names -> Names -> Error +undefinedConstructorInExpr name sims tyconNames = + let hints = [ "Type constructor "++show (show name)++" cannot be used in an expression" + | name `elem` tyconNames + ] + in Undefined Constructor name sims hints + +undefinedConstructorInPat :: Bool -> Name -> Names -> Names -> Error +undefinedConstructorInPat lhsPattern name sims tyconNames = + let hints = [ "Use identifiers starting with a lower case letter to define a function or a variable" + | lhsPattern + ] ++ + [ "Type constructor "++show (show name)++" cannot be used in a pattern" + | name `elem` tyconNames + ] + + in Undefined Constructor name sims hints + +makeNoFunDef :: Entity -> Names -> Names -> [Error] +makeNoFunDef entity names inScope = [ NoFunDef entity name inScope | name <- names ] + +-- Log-codes for Errors +errorsLogCode :: Errors -> String +errorsLogCode [] = "[]" +errorsLogCode xs = foldr1 (\x y -> x++","++y) (map errorLogCode xs) + +errorLogCode :: Error -> String +errorLogCode anError = case anError of + NoFunDef entity _ _ -> "nf" ++ code entity + Undefined entity _ _ _ -> "un" ++ code entity + Duplicated entity _ -> "du" ++ code entity + LastStatementNotExpr _ -> "ls" + WrongFileName _ _ _ -> "wf" + TypeVarApplication _ -> "tv" + ArityMismatch _ _ _ _ -> "am" + DefArityMismatch _ _ _ -> "da" + RecursiveTypeSynonyms _ -> "ts" + PatternDefinesNoVars _ -> "nv" + IntLiteralTooBig _ _ -> "il" + OverloadingDisabled _ -> "od" + OverloadedRestrPat _ -> "or" + WrongOverloadingFlag _ -> "of" + AmbiguousContext _ -> "ac" + UnknownClass _ -> "uc" + NonDerivableClass _ -> "nd" + CannotDerive _ _ -> "cd" + TupleTooBig _ -> "tt" + where code entity = fromMaybe "??" + . lookup entity + $ [ (TypeSignature ,"ts"), (TypeVariable ,"tv"), (TypeConstructor,"tc") + , (Definition ,"de"), (Constructor ,"co"), (Variable ,"va") + , (Import ,"im"), (ExportVariable ,"ev"), (ExportModule ,"em") + , (ExportConstructor,"ec"), (ExportTypeConstructor,"et"), (Fixity ,"fx") + ] diff --git a/src/Helium/StaticAnalysis/Messages/TypeErrors.hs b/src/Helium/StaticAnalysis/Messages/TypeErrors.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Messages/TypeErrors.hs @@ -0,0 +1,129 @@ +{-| Module : TypeErrors + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Errors that are constructed during type inferece. +-} + +module Helium.StaticAnalysis.Messages.TypeErrors where + +import Helium.StaticAnalysis.Messages.Messages +import Top.Types + +import Data.List (union, partition) +import Helium.Syntax.UHA_Syntax (Range, Name) +import Helium.Syntax.UHA_Range (getNameRange) +import Helium.StaticAnalysis.Miscellaneous.UHA_Source + +import Data.Maybe + +type TypeErrors = [TypeError] +data TypeError = TypeError + [Range] -- range(s) of the error + [MessageLine] -- oneliner messages + [(Bool, MessageBlock, MessageBlock)] -- Hugs-like table + [TypeErrorHint] -- extra hints + +type TypeErrorHint = (String, MessageBlock) + +instance HasMessage TypeError where + getMessage (TypeError _ oneliners table hints) = + let emptyLine = MessageOneLiner (MessageString "") + maybeTable | null table = [] + | otherwise = [ MessageTable (table ++ map (uncurry (<:>)) hints) ] + in oneliners ++ maybeTable ++ [emptyLine] + getRanges (TypeError ranges _ _ _) = ranges + +instance Substitutable TypeError where + sub |-> (TypeError ranges oneliner table hints) = + let table' = [ (b, sub |-> mb1, sub |-> mb2) | (b, mb1, mb2) <- table ] + hints' = [ (s, sub |-> mb) | (s, mb) <- hints ] + in TypeError ranges (sub |-> oneliner) table' hints' + ftv (TypeError _ oneliner table hints) = + ftv oneliner `union` ftv [ [mb1, mb2] | (_, mb1, mb2) <- table ] `union` ftv (map snd hints) + +makeNotGeneralEnoughTypeError :: Bool -> Range -> UHA_Source -> TpScheme -> TpScheme -> TypeError +makeNotGeneralEnoughTypeError isAnnotation range source tpscheme1 tpscheme2 = + let sub = listToSubstitution (zip (ftv [tpscheme1, tpscheme2]) [ TVar i | i <- [1..] ]) + ts1 = skolemizeFTV (sub |-> tpscheme1) + ts2 = skolemizeFTV (sub |-> tpscheme2) + special = if isAnnotation then "Type annotation" else "Type signature" + oneliner = MessageOneLiner (MessageString (special ++ " is too general")) + descr = if isAnnotation then "expression" else "function" + table = [ descr <:> MessageOneLineTree (oneLinerSource source) + , "declared type" >:> MessageType ts2 + , "inferred type" >:> MessageType ts1 + ] + hints = [ ("hint", MessageString "try removing the type signature") | not (null (ftv tpscheme1)) ] + in TypeError [range] [oneliner] table hints + +makeMissingConstraintTypeError :: Range -> Maybe UHA_Source -> TpScheme -> (Bool, Predicate) -> UHA_Source -> TypeError +makeMissingConstraintTypeError range mSource scheme (original, predicate) arisingFrom = + let special = if isJust mSource then "signature" else "annotation" + oneliner = MessageOneLiner (MessageString ("Missing class constraint in type "++special)) + table = maybe [] (\source -> ["function" <:> MessageOneLineTree (oneLinerSource source)]) mSource ++ + [ (isJust mSource, MessageString "declared type", MessageType scheme) + , "class constraint" <:> MessagePredicate predicate + , "arising from" >:> MessageOneLineTree (oneLinerSource arisingFrom) + ] + hints = [ ("hint", MessageString "add the class constraint to the type signature") | original ] + in TypeError [range] [oneliner] table hints + +makeUnresolvedOverloadingError :: UHA_Source -> String -> (TpScheme, TpScheme) -> TypeError +makeUnresolvedOverloadingError source description (functionType, usedAsType) = + let message = [ MessageOneLiner (MessageString ("Don't know which instance to choose for " ++ description)) ] + table = [ "function" <:> MessageOneLineTree (oneLinerSource source) + , "type" >:> MessageType functionType + , "used as" >:> MessageType usedAsType + , "hint" <:> MessageString ( "write an explicit type for this function" ++ + "\n e.g. (show :: [Int] -> String)") + ] + in TypeError [rangeOfSource source] message table [] + +makeReductionError :: UHA_Source -> Either (TpScheme, Tp) (String, Maybe Tp) -> ClassEnvironment -> Predicate -> TypeError +makeReductionError source extra classEnvironment (Predicate className predicateTp) = + let location = either (const "function") fst extra + message = [ MessageOneLiner $ MessageString $ "Type error in overloaded " ++ location ] + tab1 = case extra of + Left (scheme, tp) -> -- overloaded function + [ "function" <:> MessageOneLineTree (oneLinerSource source) + , "type" >:> MessageType scheme + , "used as" >:> MessageType (toTpScheme tp) + ] + Right (_, mtp) -> -- overloaded language construct + (descriptionOfSource source <:> MessageOneLineTree (oneLinerSource source)) : + maybe [] (\tp -> ["type" >:> MessageType (toTpScheme tp)]) mtp + tab2 = [ "problem" <:> MessageCompose [ MessageType (toTpScheme predicateTp) + , MessageString (" is not an instance of class "++className) + ] + ] + in TypeError [rangeOfSource source] message (tab1 ++ tab2) [("hint", MessageString hint)] + + where + hint :: String + hint = case valids of + [] -> "there are no valid instances of "++className + [x] -> "valid instance of "++className++" is "++show x + _ -> "valid instances of "++className++" are "++prettyAndList valids + + valids :: [String] + valids = let tps = [ tp | (Predicate _ tp, _) <- instances className classEnvironment ] + (tuples, others) = let p (TCon s) = isTupleConstructor s + p _ = False + in partition (p . fst . leftSpine) tps + f tp = listToSubstitution (zip (ftv tp) [ TCon s | s <- variableList ]) |-> tp + in if length tuples > 4 -- magic number! + then map (show . f) others ++ ["tuples"] + else map (show . f) tps + +makeRestrictedButOverloadedError :: Name -> TpScheme -> TypeError +makeRestrictedButOverloadedError name scheme = + let message = MessageOneLiner $ MessageString $ "Illegal overloaded type inferred for " ++ show name + table = [ "variable" <:> MessageString (show name) + , "inferred type" >:> MessageType scheme + ] + hint = "Only functions and simple patterns can have an overloaded type" + in TypeError [getNameRange name] [message] table [("hint", MessageString hint)] diff --git a/src/Helium/StaticAnalysis/Messages/Warnings.hs b/src/Helium/StaticAnalysis/Messages/Warnings.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Messages/Warnings.hs @@ -0,0 +1,154 @@ +{-| Module : Warnings + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Warnings that are reported during static analysis. + (the phase before type inference, as well as during type inference) +-} + +module Helium.StaticAnalysis.Messages.Warnings where + +import Helium.Syntax.UHA_Range (getNameRange, showRange, sortRanges) +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils +import Top.Types +import Helium.StaticAnalysis.Messages.Messages +import Data.List (intercalate) +import qualified Helium.Syntax.UHA_Pretty as PP (sem_Pattern, wrap_Pattern, Inh_Pattern (..), Syn_Pattern (..), sem_LeftHandSide, wrap_LeftHandSide, Inh_LeftHandSide (..), Syn_LeftHandSide (..), sem_Expression, wrap_Expression, Inh_Expression (..), Syn_Expression (..)) +import qualified Text.PrettyPrint.Leijen as PPrint + +------------------------------------------------------------- +-- (Static) Warnings + +type Warnings = [Warning] +data Warning = NoTypeDef Name TpScheme Bool{- toplevel? -} Bool{- simple pat and overloaded? -} + | Shadow Name Name + | Unused Entity Name + | SimilarFunctionBindings Name {- without typesignature -} Name {- with type signature -} + | SuspiciousTypeVariable Name {- the type variable -} Name {- the type constant -} + | ReduceContext Range Predicates Predicates + | MissingPatterns Range (Maybe Name) Tp [[Pattern]] String String + | UnreachablePatternCase Range Pattern + | UnreachablePatternLHS LeftHandSide + | UnreachableGuard Range Expression + | FallThrough Range + | SignatureTooSpecific Name TpScheme TpScheme + +instance HasMessage Warning where + getMessage x = let (oneliner, hints) = showWarning x + firstLine = MessageOneLiner (MessageCompose [MessageString "Warning: ", oneliner]) + in [firstLine, MessageHints "Hint" hints] + getRanges warning = case warning of + NoTypeDef name _ _ _ -> [getNameRange name] + Shadow _ name -> [getNameRange name] + Unused _ name -> [getNameRange name] + SimilarFunctionBindings n1 n2 -> sortRanges [getNameRange n1, getNameRange n2] + SuspiciousTypeVariable name _ -> [getNameRange name] + ReduceContext rng _ _ -> [rng] + MissingPatterns rng _ _ _ _ _ -> [rng] + UnreachablePatternCase rng _ -> [rng] + UnreachableGuard rng _ -> [rng] + FallThrough rng -> [rng] + UnreachablePatternLHS (LeftHandSide_Function rng _ _ ) -> [rng] + UnreachablePatternLHS (LeftHandSide_Infix rng _ _ _) -> [rng] + UnreachablePatternLHS (LeftHandSide_Parenthesized rng _ _ ) -> [rng] + SignatureTooSpecific name _ _ -> [getNameRange name] + +showWarning :: Warning -> (MessageBlock {- oneliner -}, MessageBlocks {- hints -}) +showWarning warning = case warning of + + NoTypeDef name tpscheme _ simplePat -> + ( MessageString ("Missing type signature: " ++ showNameAsVariable name ++ " :: " ++ show tpscheme) + , let hint = "Because " ++ showNameAsVariable name ++ " has an overloaded type, computations may be repeated. " ++ + "Insert the missing type signature if this is indeed your intention." + in [ MessageString hint | simplePat ] + ) + + Shadow shadowee shadower -> + ( MessageString ("Variable " ++ show (show shadower) ++ " shadows the one at " ++ showRange (getNameRange shadowee)) + , [] + ) + + Unused entity name -> + ( MessageString (capitalize (show entity) ++ " " ++ show (show name) ++ " is not used") + , [] + ) + + SimilarFunctionBindings suspect witness -> + ( let [n1, n2] = sortNamesByRange [suspect, witness] + in MessageString ("Suspicious adjacent functions " ++ (show.show) n1 ++ " and " ++ (show.show) n2) + , [] + ) + + SuspiciousTypeVariable varName conName -> + ( MessageString ("Suspicious type variable " ++ (show.show) varName) + , [ MessageString ("Did you mean the type constructor " ++ (show.show) conName ++ " ?") ] + ) + + ReduceContext _ predicates reduced -> + let showPredicates ps = "(" ++ intercalate ", " (map show ps) ++ ")" + in ( MessageString ( "The context " ++ showPredicates predicates ++ " has superfluous predicates." ) + , [ MessageString ("You may change it into " ++ showPredicates reduced ++ ".") ] + ) + + + MissingPatterns _ Nothing _ pss place sym -> + let text = "Missing " ++ plural pss "pattern" ++ " in " ++ place ++ ": " + ++ concatMap (("\n " ++).(++ (sym ++ " ...")).concatMap ((++ " ").show.semP)) pss + in (MessageString text, []) + + MissingPatterns _ (Just n) _ pss place sym + | isOperatorName n -> + let name = getNameName n + text = "Missing " ++ plural pss "pattern" ++ " in " ++ place ++ ": " + ++ concatMap (\[l, r] -> "\n " ++ (show.semP) l ++ " " ++ name ++ " " + ++ (show.semP) r ++ " " ++ sym ++ " ...") pss + in (MessageString text, []) + + | otherwise -> + let name = getNameName n + text = "Missing " ++ plural pss "pattern" ++ " in " ++ place ++ ": " + ++ concatMap (("\n " ++).(name ++).(' ' :).(++ (sym ++ " ...")).concatMap ((++ " ").show.semP)) pss + in (MessageString text, []) + + UnreachablePatternLHS lhs -> + ( MessageString ("Unreachable pattern: " ++ show (PP.text_Syn_LeftHandSide (PP.wrap_LeftHandSide (PP.sem_LeftHandSide lhs) PP.Inh_LeftHandSide))) + , [] + ) + + UnreachablePatternCase _ p -> + ( MessageString ("Unreachable pattern: " ++ (show.semP ) p) + , [] + ) + + UnreachableGuard _ e -> + ( MessageString ("Unreachable guard: | " ++ show (PP.text_Syn_Expression (PP.wrap_Expression (PP.sem_Expression e) PP.Inh_Expression))) + , [] + ) + + FallThrough _ -> + ( MessageString "It is good practise to have 'otherwise' as the last guard" + , [] + ) + + SignatureTooSpecific name signature scheme -> + ( MessageCompose + [ MessageString ( + "Declared type signature for "++show (show name)++" could be more general\n"++ + " declared type : ") + , MessageType signature + , MessageString ('\n' : " inferred type : ") + , MessageType scheme + ] + , [] + ) + +plural :: [a] -> String -> String +plural [_] = id +plural _ = (++ "s") + +semP :: Pattern -> PPrint.Doc +semP p = PP.text_Syn_Pattern (PP.wrap_Pattern (PP.sem_Pattern p) PP.Inh_Pattern) diff --git a/src/Helium/StaticAnalysis/Miscellaneous/ConstraintInfo.hs b/src/Helium/StaticAnalysis/Miscellaneous/ConstraintInfo.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Miscellaneous/ConstraintInfo.hs @@ -0,0 +1,448 @@ +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} + +{-| Module : ConstraintInfo + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + The information that is stored with each type constraint that is constructed + during type inference. +-} + +module Helium.StaticAnalysis.Miscellaneous.ConstraintInfo where + +import Helium.Main.Args (Option(..)) +import Top.Types +import Top.Ordering.Tree +import Helium.Syntax.UHA_Syntax +import Helium.StaticAnalysis.Miscellaneous.UHA_Source +import Helium.Syntax.UHA_Range +import Helium.StaticAnalysis.Messages.TypeErrors +import Helium.StaticAnalysis.Messages.Messages +import Helium.StaticAnalysis.Miscellaneous.DoublyLinkedTree +import Helium.StaticAnalysis.Miscellaneous.TypeConstraints +import Top.Constraint.Information +import Top.Implementation.Overloading +import Top.Interface.Basic (ErrorLabel) +import Top.Interface.Substitution (unificationErrorLabel) +import Top.Interface.TypeInference +import Helium.Utils.Utils (internalError) +import Data.Maybe +import Data.Function +import Data.List + +data ConstraintInfo = + CInfo_ { location :: String + , sources :: (UHA_Source, Maybe UHA_Source{- term -}) + , localInfo :: InfoTree + , properties :: Properties + , errorMessage :: Maybe TypeError + } + +instance Show ConstraintInfo where + show = location + +------------------------------------------------------------------------- +-- Properties + +type Properties = [Property] +data Property + = FolkloreConstraint + | ConstraintPhaseNumber Int + | HasTrustFactor Float + | FuntionBindingEdge Int{-number of patterns-} + | InstantiatedTypeScheme TpScheme + | SkolemizedTypeScheme (Tps, TpScheme) + | IsUserConstraint Int{-user-constraint-group unique number-} Int{-constraint number within group-} + | WithHint (String, MessageBlock) + | ReductionErrorInfo Predicate + | FromBindingGroup + | IsImported Name + | ApplicationEdge Bool{-is binary-} [LocalInfo]{-info about terms-} + | ExplicitTypedBinding -- superfluous? + | ExplicitTypedDefinition Tps{- monos-} Name{- function name -} + | Unifier Int{-type variable-} (String{-location-}, LocalInfo, String{-description-}) + | EscapedSkolems [Int] + | PredicateArisingFrom (Predicate, ConstraintInfo) + | TypeSignatureLocation Range + | TypePair (Tp, Tp) + +class HasProperties a where + getProperties :: a -> Properties + addProperty :: Property -> a -> a + addProperties :: Properties -> a -> a + + -- default definitions + addProperty = addProperties . (:[]) + addProperties = flip (foldr addProperty) + +instance HasProperties Properties where + getProperties = id + addProperty = (:) + addProperties = (++) + +instance HasProperties ConstraintInfo where + getProperties = properties + addProperties ps info = + info { properties = ps ++ properties info } + +------------------------------------------------------------------------- +-- Property functions + +maybeHead :: [a] -> Maybe a +maybeHead [] = Nothing +maybeHead (a:_) = Just a + +headWithDefault :: a -> [a] -> a +headWithDefault a = fromMaybe a . maybeHead + +maybeReductionErrorPredicate :: HasProperties a => a -> Maybe Predicate +maybeReductionErrorPredicate a = + maybeHead [ p | ReductionErrorInfo p <- getProperties a ] + +isFolkloreConstraint :: HasProperties a => a -> Bool +isFolkloreConstraint a = + not $ null [ () | FolkloreConstraint <- getProperties a ] + +-- |Returns only type schemes with at least one quantifier +maybeInstantiatedTypeScheme :: HasProperties a => a -> Maybe TpScheme +maybeInstantiatedTypeScheme a = + maybeHead [ s | InstantiatedTypeScheme s <- getProperties a, not (withoutQuantors s) ] + +maybeSkolemizedTypeScheme :: HasProperties a => a -> Maybe (Tps, TpScheme) +maybeSkolemizedTypeScheme info = + maybeHead [ s | SkolemizedTypeScheme s <- getProperties info ] + +maybeUserConstraint :: HasProperties a => a -> Maybe (Int, Int) +maybeUserConstraint a = + maybeHead [ (x, y) | IsUserConstraint x y <- getProperties a ] + +phaseOfConstraint :: HasProperties a => a -> Int +phaseOfConstraint a = + headWithDefault 5 [ i | ConstraintPhaseNumber i <- getProperties a ] + +isExplicitTypedBinding :: HasProperties a => a -> Bool +isExplicitTypedBinding a = + not $ null [ () | ExplicitTypedBinding <- getProperties a ] + +maybeExplicitTypedDefinition :: HasProperties a => a -> Maybe (Tps, Name) +maybeExplicitTypedDefinition a = + maybeHead [ (ms, n) | ExplicitTypedDefinition ms n <- getProperties a ] + +maybeTypeSignatureLocation :: HasProperties a => a -> Maybe Range +maybeTypeSignatureLocation a = + maybeHead [ r | TypeSignatureLocation r <- getProperties a ] + +maybePredicateArisingFrom :: HasProperties a => a -> Maybe (Predicate, ConstraintInfo) +maybePredicateArisingFrom a = + maybeHead [ t | PredicateArisingFrom t <- getProperties a ] + +getEscapedSkolems :: HasProperties a => a -> [Int] +getEscapedSkolems a = + concat [ is | EscapedSkolems is <- getProperties a ] + +----------------------------------------------------------------- +-- Smart constructors + +childConstraint :: Int -> String -> InfoTree -> Properties -> ConstraintInfo +childConstraint childNr theLocation infoTree theProperties = + CInfo_ { location = theLocation + , sources = ( (self . attribute) infoTree + , Just $ (self . attribute . selectChild childNr) infoTree + ) + , localInfo = infoTree + , properties = theProperties + , errorMessage = Nothing + } + +specialConstraint :: String -> InfoTree -> (UHA_Source, Maybe UHA_Source) -> Properties -> ConstraintInfo +specialConstraint theLocation infoTree theSources theProperties = + CInfo_ { location = theLocation + , sources = theSources + , localInfo = infoTree + , properties = theProperties + , errorMessage = Nothing + } + +orphanConstraint :: Int -> String -> InfoTree -> Properties -> ConstraintInfo +orphanConstraint childNr theLocation infoTree theProperties = + CInfo_ { location = theLocation + , sources = ( (self . attribute . selectChild childNr) infoTree + , Nothing + ) + , localInfo = infoTree + , properties = theProperties + , errorMessage = Nothing + } + +resultConstraint :: String -> InfoTree -> Properties -> ConstraintInfo +resultConstraint theLocation infoTree theProperties = + CInfo_ { location = theLocation + , sources = ( (self . attribute) infoTree + , Nothing + ) + , localInfo = infoTree + , properties = theProperties + , errorMessage = Nothing + } + +variableConstraint :: String -> UHA_Source -> Properties -> ConstraintInfo +variableConstraint theLocation theSource theProperties = + CInfo_ { location = theLocation + , sources = (theSource, Nothing) + , localInfo = root LocalInfo { self = theSource, assignedType = Nothing {- ?? -}, monos = [] } [] + , properties = theProperties + , errorMessage = Nothing + } + +cinfoBindingGroupExplicitTypedBinding :: Tps -> Name -> Name -> ConstraintInfo +cinfoSameBindingGroup :: Name -> ConstraintInfo +cinfoBindingGroupImplicit :: Name -> ConstraintInfo +cinfoBindingGroupExplicit :: Tps -> Names -> Name -> ConstraintInfo +cinfoGeneralize :: Name -> ConstraintInfo + +cinfoBindingGroupExplicitTypedBinding ms name nameTS = + let props = [ FromBindingGroup, ExplicitTypedBinding, ExplicitTypedDefinition ms name, + HasTrustFactor 10.0, TypeSignatureLocation (getNameRange nameTS) ] + in variableConstraint "explicitly typed binding" (nameToUHA_Def name) props +cinfoSameBindingGroup name = + let props = [ FromBindingGroup, FolkloreConstraint ] + in variableConstraint "variable" (nameToUHA_Expr name) props +cinfoBindingGroupImplicit name = + let props = [ FromBindingGroup, FolkloreConstraint, HasTrustFactor 10.0 ] + in variableConstraint "variable" (nameToUHA_Expr name) props +cinfoBindingGroupExplicit ms defNames name = + let props1 = [ FromBindingGroup, FolkloreConstraint ] + props2 = case filter (name==) defNames of + [defName] -> [ExplicitTypedDefinition ms defName] + _ -> [] + in variableConstraint "variable" (nameToUHA_Expr name) (props1 ++ props2) +cinfoGeneralize name = + variableConstraint ("Generalize " ++ show name) (nameToUHA_Expr name) [] + +type InfoTrees = [InfoTree] +type InfoTree = DoublyLinkedTree LocalInfo + +data LocalInfo = + LocalInfo { self :: UHA_Source + , assignedType :: Maybe Tp + , monos :: Tps + } + +-- For Proxima +typeSchemesInInfoTree :: FixpointSubstitution -> Predicates -> InfoTree -> [(Range, TpScheme)] +typeSchemesInInfoTree subst ps infoTree = + let local = attribute infoTree + rest = concatMap (typeSchemesInInfoTree subst ps) (children infoTree) + in case assignedType local of + Just tp -> let is = ftv tp + ps' = filter (any (`elem` is) . ftv) ps + scheme = generalizeAll (subst |-> (ps' .=>. tp)) + in (rangeOfSource (self local), scheme) : rest + Nothing -> rest + +type ConstraintSet = Tree (TypeConstraint ConstraintInfo) +type ConstraintSets = Trees (TypeConstraint ConstraintInfo) + +instance TypeConstraintInfo ConstraintInfo where + unresolvedPredicate = addProperty . ReductionErrorInfo + ambiguousPredicate = addProperty . ReductionErrorInfo + escapedSkolems = addProperty . EscapedSkolems + predicateArisingFrom = addProperty . PredicateArisingFrom + equalityTypePair = setTypePair + + +instance PolyTypeConstraintInfo ConstraintInfo where + instantiatedTypeScheme = addProperty . InstantiatedTypeScheme + skolemizedTypeScheme = addProperty . SkolemizedTypeScheme + + + +highlyTrustedFactor :: Float +highlyTrustedFactor = 10000.0 + +highlyTrusted :: Property +highlyTrusted = HasTrustFactor highlyTrustedFactor + +isHighlyTrusted :: ConstraintInfo -> Bool +isHighlyTrusted info = + product [ i | HasTrustFactor i <- properties info ] >= highlyTrustedFactor + +setTypePair :: (Tp, Tp) -> ConstraintInfo -> ConstraintInfo +setTypePair pair = addProperty (TypePair pair) + +typepair :: ConstraintInfo -> (Tp, Tp) +typepair info = fromJust (maybeHead [ pair | TypePair pair <- getProperties info ]) + +isExprTyped :: ConstraintInfo -> Bool +isExprTyped info = + case fst (sources info) of + UHA_Expr (Expression_Typed _ _ _) -> True + _ -> False + +tooGeneralLabels :: [ErrorLabel] +tooGeneralLabels = [skolemVersusConstantLabel, skolemVersusSkolemLabel, escapingSkolemLabel] + +-- TODO: get rid of the TypeError and TypeErrorHint data types, and move the following two functions +-- to the module TypeErrors + +makeTypeErrors :: Substitution sub => [Option] -> ClassEnvironment -> OrderedTypeSynonyms -> sub -> [(ConstraintInfo, ErrorLabel)] -> TypeErrors +makeTypeErrors options classEnv synonyms sub errors = + let --comp l1 l2 + -- | l1 `elem` tooGeneralLabels && l2 `elem` tooGeneralLabels = EQ + -- | otherwise = l1 `compare` l2 + + list = groupBy ((==) `on` snd) + $ sortBy (compare `on` snd) + $ (if NoOverloadingTypeCheck `elem` options + then filter ((/= ambiguousLabel) . snd) + else id) + errors + final = groupBy ((==) `on` fst) + $ sortBy (compare `on` fst) + $ filter (not . null . snd) + [ make label (info : map fst rest) | (info, label):rest <- list ] + in case final of + [] -> [] + hd:_ -> concatMap snd hd + + where + special :: ConstraintInfo -> TypeError -> TypeError + special info defaultMessage = + maybe defaultMessage (sub |->) (maybeSpecialTypeError info) + + make :: ErrorLabel -> [ConstraintInfo] -> (Int, TypeErrors) + make label infos + + -- an unification error: first test if the two types can really not be unified + | label == unificationErrorLabel = + let f info = + case mguWithTypeSynonyms synonyms (sub |-> fst (typepair info)) (sub |-> snd (typepair info)) of + Left (InfiniteType _) -> + let hint = ("because", MessageString "unification would give infinite type") + in [ sub |-> special info (makeUnificationTypeError (addProperty (WithHint hint) info)) ] + Left _ -> + [ sub |-> special info (makeUnificationTypeError info) ] + Right _ -> [] + in (1, concatMap f infos) + + -- missing class predicate in declared type (hence, declared type is too general) + | label == missingInSignatureLabel = + let f info = + let (p, infoArising) = fromMaybe err (maybePredicateArisingFrom info) + range = fromMaybe err (maybeTypeSignatureLocation info) + mSource = if isExprTyped info then Nothing else Just (fst $ sources info) + scheme = maybe err snd (maybeSkolemizedTypeScheme info) + t1 = freezeVariablesInType (unqualify (unquantify scheme)) + t2 = sub |-> fst (typepair info) + tuple = case mguWithTypeSynonyms synonyms t1 t2 of + Left _ -> (False, p) + Right (_, sub1) -> + let Predicate className tp = sub1 |-> p + sub' = listToSubstitution [ (i, TCon s) | (i, s) <- getQuantorMap scheme ] + in (True, Predicate className (sub' |-> unfreezeVariablesInType tp)) + err = internalError "ConstraintInfo" "makeTypeErrors" "unknown class predicate" + in special info (makeMissingConstraintTypeError range mSource scheme tuple (fst $ sources infoArising)) + in (2, map f infos) + + -- declared type is too general + | label `elem` tooGeneralLabels = + let f info = + let monoset = sub |-> ms + range = fromMaybe err (maybeTypeSignatureLocation info) + scheme1 = generalize monoset ([] .=>. sub |-> snd (typepair info)) + (ms, scheme2) = fromMaybe err (maybeSkolemizedTypeScheme info) + source = uncurry fromMaybe (sources info) + err = internalError "ConstraintInfo" "makeTypeErrors" "unknown original type scheme" + in special info (makeNotGeneralEnoughTypeError (isExprTyped info) range source scheme1 scheme2) + in (if label == escapingSkolemLabel then 3 else 2, map f infos) + + -- a reduction error + | label == unresolvedLabel = + let f info = + let source = fst (sources info) + extra = case maybeInstantiatedTypeScheme info of + Just scheme -> -- overloaded function + Left (scheme, snd $ typepair info) + Nothing -> --overloaded language construct + Right (location info, sub |-> assignedType (attribute (localInfo info))) + pred' = let err = internalError "ConstraintInfo" "makeTypeErrors" + "unknown predicate which resulted in a reduction error" + in fromMaybe err $ maybeReductionErrorPredicate info + in special info (sub |-> makeReductionError source extra classEnv pred') + in (4, map f infos) + + -- ambiguous class predicates + | label == ambiguousLabel = + let f info = + let scheme1 = fromMaybe err (maybeInstantiatedTypeScheme info) + scheme2 = generalizeAll ([] .=>. sub |-> fst (typepair info)) + className = maybe err (\(Predicate x _) -> x) (maybeReductionErrorPredicate info) + err = internalError "ConstraintInfo" "makeTypeErrors" "unknown original type scheme" + in special info (makeUnresolvedOverloadingError (fst $ sources info) className (scheme1, scheme2)) + in (5, map f infos) + + | otherwise = + internalError "ConstraintInfo" "makeTypeErrors" ("unknown label "++show label) + +makeUnificationTypeError :: ConstraintInfo -> TypeError +makeUnificationTypeError info = + let (source, term) = sources info + range = maybe (rangeOfSource source) rangeOfSource term + oneliner = MessageOneLiner (MessageString ("Type error in " ++ location info)) + (t1, t2) = typepair info + msgtp1 = fromMaybe (toTpScheme t1) (maybeInstantiatedTypeScheme info) + msgtp2 = maybe (toTpScheme t2) snd (maybeSkolemizedTypeScheme info) + (reason1, reason2) + | isJust (maybeSkolemizedTypeScheme info) = ("inferred type", "declared type") + | isFolkloreConstraint info = ("type" , "expected type") + | otherwise = ("type" , "does not match") + table = [ s <:> MessageOneLineTree (oneLinerSource source') | (s, source') <- convertSources (sources info)] + ++ + [ reason1 >:> MessageType msgtp1 + , reason2 >:> MessageType msgtp2 + ] + hints = [ hint | WithHint hint <- properties info ] + in TypeError [range] [oneliner] table hints + +------------------------------------- +-- from the type inference directives + +emptyConstraintInfo :: ConstraintInfo +emptyConstraintInfo = + CInfo_ { location = "Typing Strategy" + , sources = (UHA_Decls [], Nothing) + , localInfo = root (LocalInfo (UHA_Decls []) Nothing []) [] + , properties = [] + , errorMessage = Nothing + } + +defaultConstraintInfo :: (UHA_Source, Maybe UHA_Source) -> ConstraintInfo +defaultConstraintInfo sourceTuple@(s1, s2) = + CInfo_ { location = descriptionOfSource theSource -- not very precise: expression, pattern, etc. + , sources = sourceTuple + , localInfo = root myLocal [] + , properties = [] + , errorMessage = Nothing + } + where myLocal = LocalInfo {self = theSource, assignedType = Nothing, monos = []} + theSource = fromMaybe s1 s2 + +standardConstraintInfo :: ConstraintInfo +standardConstraintInfo = + CInfo_ { location = "Typing Strategy" + , sources = (UHA_Decls [], Nothing) + , localInfo = root myLocal [] + , properties = [ ] + , errorMessage = Nothing + } + where myLocal = LocalInfo {self = UHA_Decls [], assignedType = Nothing, monos = []} + +maybeSpecialTypeError :: ConstraintInfo -> Maybe TypeError +maybeSpecialTypeError = errorMessage + +setTypeError :: TypeError -> ConstraintInfo -> ConstraintInfo +setTypeError typeError info = + info { errorMessage = Just typeError } diff --git a/src/Helium/StaticAnalysis/Miscellaneous/DoublyLinkedTree.hs b/src/Helium/StaticAnalysis/Miscellaneous/DoublyLinkedTree.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Miscellaneous/DoublyLinkedTree.hs @@ -0,0 +1,35 @@ +{-| Module : DoublyLinkedTree + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + In a doubly linked, every node has access to its parent and its children. + At each node, extra information (attributes) can be stored. +-} + +module Helium.StaticAnalysis.Miscellaneous.DoublyLinkedTree where + +import Helium.Utils.Utils (internalError) + +data DoublyLinkedTree attributes = + DoublyLinkedTree { parent :: Maybe (DoublyLinkedTree attributes) + , attribute :: attributes + , children :: [DoublyLinkedTree attributes] + } + +root :: a -> [DoublyLinkedTree a] -> DoublyLinkedTree a +root = DoublyLinkedTree Nothing + +node :: DoublyLinkedTree a -> a -> [DoublyLinkedTree a] -> DoublyLinkedTree a +node p = DoublyLinkedTree (Just p) + +selectChild :: Int -> DoublyLinkedTree a -> DoublyLinkedTree a +selectChild i tree = + case drop i (children tree) of + [] -> internalError "TypeInferDoublyLinkedTreenceInfo.hs" "selectChild" "no such child" + hd:_ -> hd + +selectRoot :: DoublyLinkedTree a -> DoublyLinkedTree a +selectRoot tree = maybe tree selectRoot (parent tree) diff --git a/src/Helium/StaticAnalysis/Miscellaneous/TypeConstraints.hs b/src/Helium/StaticAnalysis/Miscellaneous/TypeConstraints.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Miscellaneous/TypeConstraints.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE UndecidableInstances, RankNTypes, FlexibleInstances, MultiParamTypeClasses #-} +{-| Module : TypeConstraints + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + The type constraints used by the Helium compiler (all derived from the + basic constraints that are supplied by the Top framework). Some constraints + are lifted to work on finite maps as well. +-} + +module Helium.StaticAnalysis.Miscellaneous.TypeConstraints where + +import Top.Constraint +import Top.Constraint.Equality hiding ((.==.)) +import Top.Constraint.Qualifier +import Top.Constraint.Polymorphism hiding ((.::.)) +import Top.Constraint.Information +import Top.Interface.Basic +import Top.Interface.Substitution +import Top.Interface.TypeInference +import Top.Interface.Qualification +import Top.Types +import qualified Data.Map as M + +type TypeConstraints info = [TypeConstraint info] +data TypeConstraint info + = TC1 (EqualityConstraint info) + | TC2 (ExtraConstraint info) + | TC3 (PolymorphismConstraint info) + | TCOper String (forall m . HasSubst m info => m ()) + +instance (HasBasic m info, HasTI m info, HasSubst m info, HasQual m info, PolyTypeConstraintInfo info) + => Solvable (TypeConstraint info) m where + solveConstraint (TC1 c) = solveConstraint c + solveConstraint (TC2 c) = solveConstraint c + solveConstraint (TC3 c) = solveConstraint c + solveConstraint (TCOper _ f) = f + checkCondition (TC1 c) = checkCondition c + checkCondition (TC2 c) = checkCondition c + checkCondition (TC3 c) = checkCondition c + checkCondition (TCOper _ _) = return True + +instance Show info => Show (TypeConstraint info) where + show (TC1 c) = show c + show (TC2 c) = show c + show (TC3 c) = show c + show (TCOper s _) = s + +instance Substitutable (TypeConstraint info) where + sub |-> (TC1 c) = TC1 (sub |-> c) + sub |-> (TC2 c) = TC2 (sub |-> c) + sub |-> (TC3 c) = TC3 (sub |-> c) + _ |-> tc = tc + ftv (TC1 c) = ftv c + ftv (TC2 c) = ftv c + ftv (TC3 c) = ftv c + ftv _ = [] + +------------ + +polySubst :: M.Map Int (Scheme Predicates) -> TypeConstraint info -> TypeConstraint info +polySubst schemeMap tc = + case tc of + TC3 (Instantiate tp sigma info) -> TC3 (Instantiate tp (f sigma) info) + TC3 (Skolemize tp (monos, sigma) info) -> TC3 (Skolemize tp (monos, f sigma) info) + _ -> tc + + where + f :: Sigma Predicates -> Sigma Predicates + f sigma = + case sigma of + SigmaVar i -> maybe sigma SigmaScheme (M.lookup i schemeMap) + _ -> sigma + +spreadFunction :: TypeConstraint info -> Maybe Int +spreadFunction tc = + case tc of + TC1 (Equality _ t2 _) -> spreadFromType t2 + TC3 (Instantiate tp _ _) -> spreadFromType tp + TC3 (Skolemize tp _ _) -> spreadFromType tp + TC3 (Implicit t1 (_, _) _) -> spreadFromType t1 + _ -> Nothing + +spreadFromType :: Tp -> Maybe Int +spreadFromType (TVar i) = Just i +spreadFromType _ = Nothing + +------------------------------------------------------------------------------ +-- Lifted constructors + +infix 3 .==., .===., .::., .:::., !::!, !:::!, .<=., .<==., !<=!, !<==! + +lift :: Ord k => (a1 -> t1 -> t2 -> a) -> M.Map k a1 + -> M.Map k [(t, t1)] -> (t -> t2) -> ([a], M.Map k [(t, t1)]) +lift combinator as bs cf = + let constraints = concat (M.elems (M.intersectionWith f as bs)) + rest = bs M.\\ as + f a list = [ (a `combinator` b) (cf name) | (name,b) <- list ] + in (constraints, rest) + +(.==.) :: Show info => Tp -> Tp -> info -> TypeConstraint info +(t1 .==. t2) info = TC1 (Equality t1 t2 info) + +(.===.) :: (Show info, Ord key) => M.Map key Tp -> M.Map key [(key,Tp)] -> (key -> info) -> ([TypeConstraint info], M.Map key [(key,Tp)]) +(.===.) = lift (.==.) + +(.::.) :: Show info => Tp -> TpScheme -> info -> TypeConstraint info +tp .::. ts = tp .<=. SigmaScheme ts + +(.:::.) :: (Show info, Ord key) => M.Map key TpScheme -> M.Map key [(key,Tp)] -> (key -> info) -> ([TypeConstraint info], M.Map key [(key,Tp)]) +(.:::.) = lift (flip (.::.)) + +(!::!) :: Tp -> TpScheme -> Tps -> info -> TypeConstraint info +(tp !::! ts) monos info = TC3 (Skolemize tp (monos, SigmaScheme ts) info) + +(!:::!) :: (Show info, Ord key) => M.Map key TpScheme -> M.Map key Tp -> Tps -> (Tps -> key -> key -> info) -> ([TypeConstraint info], M.Map key Tp) +(as !:::! bs) monos info = + let op key tp (cs, fm) = + case M.lookup key as of + Just ts -> + let -- the key of the type scheme (equal, but may have a different range). + key' = head (filter (==key) (M.keys as)) {- this is the other name -} + in ((tp !::! ts) monos (info monos key key') : cs, fm) + Nothing -> (cs, M.insert key tp fm) + in M.foldWithKey op ([], M.empty) bs + +(.<=.) :: Show info => Tp -> Sigma Predicates -> info -> TypeConstraint info +(tp .<=. ts) info = TC3 (Instantiate tp ts info) + +(.<==.) :: (Show info, Ord key) => M.Map key (Sigma Predicates) -> M.Map key [(key,Tp)] -> (key -> info) -> ([TypeConstraint info], M.Map key [(key,Tp)]) +(.<==.) = lift (flip (.<=.)) + +-- the old implicit instance constraint +(!<=!) :: Show info => Tps -> Tp -> Tp -> info -> TypeConstraint info +(!<=!) ms t1 t2 info = TC3 (Implicit t1 (ms, t2) info) + +(!<==!) :: (Show info, Ord key) => Tps -> M.Map key Tp -> M.Map key [(key,Tp)] -> (key -> info) -> ([TypeConstraint info], M.Map key [(key,Tp)]) +(!<==!) ms = lift (ms !<=!) + +genConstraints :: Tps -> (key -> info) -> [(Int, (key, Tp))] -> TypeConstraints info +genConstraints monos infoF = + let f (sv, (key, tp)) = TC3 (Generalize sv (monos, tp) (infoF key)) + in map f + +predicate :: Predicate -> info -> TypeConstraint info +predicate p cinfo = TC2 (Prove p cinfo) diff --git a/src/Helium/StaticAnalysis/Miscellaneous/TypeConversion.hs b/src/Helium/StaticAnalysis/Miscellaneous/TypeConversion.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Miscellaneous/TypeConversion.hs @@ -0,0 +1,98 @@ +{-| Module : TypeConversion + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + The conversion from UHA types to Tp (a simpler representation), and vice versa. +-} + +module Helium.StaticAnalysis.Miscellaneous.TypeConversion where + + +import Helium.Syntax.UHA_Utils (getNameName, nameFromString) +import Helium.Syntax.UHA_Range (noRange) +import Helium.Utils.Utils (internalError) +import Data.List (union) +import Data.Maybe +import Helium.Syntax.UHA_Syntax + +import Top.Types + +---------------------------------------------------------------------- +-- conversion functions from and to UHA + +namesInTypes :: Types -> Names +namesInTypes = foldr (union . namesInType) [] + +namesInType :: Type -> Names +namesInType uhaType = case uhaType of + + Type_Application _ _ fun args -> namesInTypes (fun : args) + Type_Variable _ name -> [name] + Type_Constructor _ _ -> [] + Type_Parenthesized _ t -> namesInType t + Type_Qualified _ _ t -> namesInType t + Type_Forall{} -> internalError "TypeConversion.hs" "namesInType" "universal types are currently not supported" + Type_Exists{} -> internalError "TypeConversion.hs" "namesInType" "existential types are currently not supported" + +-- name maps play an important role in converting since they map UHA type variables (string) to TVar's (int) +makeNameMap :: Names -> [(Name,Tp)] +makeNameMap = flip zip (map TVar [0..]) + +-- also return the name map +makeTpSchemeFromType' :: Type -> (TpScheme, [(Int, Name)]) +makeTpSchemeFromType' uhaType = + let names = namesInType uhaType + nameMap = makeNameMap names + intMap = zip [0..] names + context = predicatesFromContext nameMap uhaType + tp = makeTpFromType nameMap uhaType + scheme = Quantification (ftv tp, [ (i,getNameName n) | (n,TVar i) <- nameMap], context .=>. tp) + in (scheme, intMap) + +makeTpSchemeFromType :: Type -> TpScheme +makeTpSchemeFromType = fst . makeTpSchemeFromType' + +predicatesFromContext :: [(Name,Tp)] -> Type -> Predicates +predicatesFromContext nameMap (Type_Qualified _ is _) = + concatMap predicateFromContext is + where + predicateFromContext (ContextItem_ContextItem _ cn [Type_Variable _ vn]) = + case lookup vn nameMap of + Nothing -> [] + Just tp -> [Predicate (getNameName cn) tp] + predicateFromContext _ = internalError "TypeConversion.hs" "predicateFromContext" "malformed type in context" +predicatesFromContext _ _ = [] + +makeTpFromType :: [(Name,Tp)] -> Type -> Tp +makeTpFromType nameMap = rec_ + where + rec_ :: Type -> Tp + rec_ uhaType = case uhaType of + Type_Application _ _ fun args -> foldl TApp (rec_ fun) (map rec_ args) + Type_Variable _ name -> fromMaybe (TCon "???") (lookup name nameMap) + Type_Constructor _ name -> TCon (getNameName name) + Type_Parenthesized _ t -> rec_ t + Type_Qualified _ _ t -> rec_ t + Type_Forall{} -> internalError "TypeConversion.hs" "makeTpFromType" "universal types are currently not supported" + Type_Exists{} -> internalError "TypeConversion.hs" "makeTpFromType" "existential types are currently not supported" + +convertFromSimpleTypeAndTypes :: SimpleType -> Types -> (Tp,Tps) +convertFromSimpleTypeAndTypes stp tps = + let SimpleType_SimpleType _ name typevariables = stp + nameMap = makeNameMap (foldr union [] (typevariables : map namesInType tps)) + simpletype = foldl TApp (TCon (getNameName name)) (take (length typevariables) (map TVar [0..])) + in (simpletype,map (makeTpFromType nameMap) tps) + +makeTypeFromTp :: Tp -> Type +makeTypeFromTp t = + let (x,xs) = leftSpine t + in if null xs + then f x + else Type_Application noRange True (f x) (map makeTypeFromTp xs) + where f (TVar i) = Type_Variable noRange (nameFromString ('v' : show i)) + f (TCon s) = Type_Constructor noRange (nameFromString s) + f (TApp _ _) = error "TApp case in makeTypeFromTp" + diff --git a/src/Helium/StaticAnalysis/Miscellaneous/TypesToAlignedDocs.hs b/src/Helium/StaticAnalysis/Miscellaneous/TypesToAlignedDocs.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Miscellaneous/TypesToAlignedDocs.hs @@ -0,0 +1,122 @@ +{-| Module : TypesToAlignedDocs + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Functions to align and show types. +-} + +module Helium.StaticAnalysis.Miscellaneous.TypesToAlignedDocs (qualifiedTypesToAlignedDocs, typesToAlignedDocs) where + +import Data.List ( transpose ) +import Top.Types +import Text.PrettyPrint.Leijen +import qualified Text.PrettyPrint.Leijen as PPrint + +qualifiedTypesToAlignedDocs :: [QType] -> [PPrint.Doc] +qualifiedTypesToAlignedDocs qtps = + let (contexts, types) = unzip (map split qtps) + docContexts = map text . sameLengthRight . map showContext $ contexts + docTypes = typesToAlignedDocs types + in if null (concat contexts) + then docTypes + else zipWith (<>) docContexts docTypes + +typesToAlignedDocs :: Tps -> [PPrint.Doc] +typesToAlignedDocs [] = [] +typesToAlignedDocs tps + + | allFunctionType + = let functionSpines = map functionSpine tps + shortestSpine = minimum (map (length . fst) functionSpines) + tupleSpines = map partOfSpine functionSpines + partOfSpine (ts, t) = let (xs, ys) = splitAt shortestSpine ts + in (xs, foldr (.->.) t ys) + (left, right) = unzip tupleSpines + docsLeft = recs (<1) left + docsRight = rec_ (const False) right + in map funDocs (zipWith (\xs x -> xs++[x]) docsLeft docsRight) + + | allVariable + = map PPrint.text (sameLength [ 'v' : show i | (TVar i, _) <- spines]) + + | allConstant + = map PPrint.text (sameLength [ s | (TCon s, _) <- spines]) + + | allListType + = map PPrint.brackets (rec_ (const False) (map (head . snd) spines)) + + | allSameTuple + = map tupleDocs (recs (const False) (map snd spines)) + + | allSameConstructor + = map appDocs (recs (<2) [ x:xs | (x, xs) <- spines ]) + + | otherwise + = map PPrint.text $ sameLength $ map show tps + + where spines = map leftSpine tps + allSameConstructor = all isTCon (map fst spines) + && allEqual [ s | (TCon s, _) <- spines ] + && allEqual [ length xs | (_, xs) <- spines ] + allSameTuple = all isTCon (map fst spines) + && all isTupleConstructor [ s | (TCon s, _) <- spines ] + && allEqual [ s | (TCon s, _) <- spines ] + && allEqual [ length xs | (_, xs) <- spines ] + allListType = all isTCon (map fst spines) + && all ("[]"==) [ s | (TCon s, _) <- spines ] + && all (1==) [length xs | (_, xs) <- spines ] + allConstant = all isTCon (map fst spines) + && all null (map snd spines) + allVariable = all isTVar (map fst spines) + && all null (map snd spines) + allFunctionType = all isTCon (map fst spines) + && all ("->"==) [ s | (TCon s, _) <- spines ] + && all (2==) [length xs | (_, xs) <- spines ] + +recs :: (Int -> Bool) -> [Tps] -> [[PPrint.Doc]] +recs predicate = transpose . map (rec_ predicate) . transpose + +rec_ :: (Int -> Bool) -> Tps -> [PPrint.Doc] +rec_ predicate tps = + let docs = typesToAlignedDocs tps + bools = map (predicate . priorityOfType) tps + maybeParenthesize b doc + | b = PPrint.parens doc + | or bools = doc <> PPrint.text " " + | otherwise = doc + in zipWith maybeParenthesize bools docs + +--showTwoTypesSpecial (t1,t2) = +-- let [d1,d2] = typesToAlignedDocs [t1,t2] +-- in (d1,d2) + +--showTwoTypes = showTwoTypesSpecial + +allEqual :: Eq a => [a] -> Bool +allEqual [] = True +allEqual (x:xs) = all (x==) xs + +sameLength :: [String] -> [String] +sameLength xs = + let n = maximum (0 : map length xs) + f = take n . (++repeat ' ') + in map f xs + +sameLengthRight :: [String] -> [String] +sameLengthRight = + map reverse . sameLength . map reverse + +appDocs :: [Doc] -> Doc +appDocs = foldl1 (\d1 d2 -> PPrint.group $ d1 <> line <> d2) + +tupleDocs :: [Doc] -> Doc +tupleDocs [] = PPrint.text "()" +tupleDocs ds = PPrint.hang 0 $ PPrint.group (PPrint.text "(" <> + foldl1 (\d1 d2 -> d1 <> line <> PPrint.text "," <+> d2) ds) + <> PPrint.text ")" + +funDocs :: [Doc] -> Doc +funDocs = PPrint.group . foldl1 (\d1 d2 -> d1 <> line <> text "->" <+> d2) diff --git a/src/Helium/StaticAnalysis/Miscellaneous/UHA_Source.hs b/src/Helium/StaticAnalysis/Miscellaneous/UHA_Source.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/Miscellaneous/UHA_Source.hs @@ -0,0 +1,93 @@ +{-| Module : UHA_Source + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + The UHA_Source data type is the union of several data types from the abstract + syntax (UHA), including expressions and patterns. +-} + +module Helium.StaticAnalysis.Miscellaneous.UHA_Source where + +import Helium.Utils.OneLiner +import Helium.Syntax.UHA_Range +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils +import qualified Helium.Syntax.UHA_OneLine as PP + +data UHA_Source = + UHA_Expr Expression + | UHA_Pat Pattern + | UHA_Stat Statement + | UHA_Qual Qualifier + | UHA_FB FunctionBinding + | UHA_RHS RightHandSide + | UHA_Decl Declaration + | UHA_Decls Declarations + | UHA_Def Name + +instance Show UHA_Source where + show = showOneLine 80 . oneLinerSource + +rangeOfSource :: UHA_Source -> Range +rangeOfSource source = + case source of + UHA_Expr expr -> getExprRange expr + UHA_Pat pat -> getPatRange pat + UHA_Stat stat -> getStatementRange stat + UHA_Qual qual -> getQualifierRange qual + UHA_FB fb -> getFBRange fb + UHA_RHS rhs -> getRHSRange rhs + UHA_Decl decl -> getDeclarationRange decl + UHA_Decls decls -> if null decls then noRange else foldr1 mergeRanges (map getDeclarationRange decls) + UHA_Def name -> getNameRange name + +oneLinerSource :: UHA_Source -> OneLineTree +oneLinerSource source = + case source of + UHA_Expr expr -> PP.oneLineTree_Syn_Expression (PP.wrap_Expression (PP.sem_Expression expr) PP.Inh_Expression) + UHA_Pat pat -> PP.oneLineTree_Syn_Pattern (PP.wrap_Pattern (PP.sem_Pattern pat) PP.Inh_Pattern) + UHA_Stat stat -> PP.oneLineTree_Syn_Statement (PP.wrap_Statement (PP.sem_Statement stat) PP.Inh_Statement) + UHA_Qual qual -> PP.oneLineTree_Syn_Qualifier (PP.wrap_Qualifier (PP.sem_Qualifier qual) PP.Inh_Qualifier) + UHA_FB fb -> PP.oneLineTree_Syn_FunctionBinding (PP.wrap_FunctionBinding (PP.sem_FunctionBinding fb) PP.Inh_FunctionBinding) + UHA_RHS rhs -> PP.oneLineTree_Syn_RightHandSide (PP.wrap_RightHandSide (PP.sem_RightHandSide rhs) PP.Inh_RightHandSide) "" + UHA_Decl decl -> PP.oneLineTree_Syn_Declaration (PP.wrap_Declaration (PP.sem_Declaration decl) PP.Inh_Declaration) + UHA_Decls decls -> PP.encloseSep "{" "; " "}" (PP.oneLineTree_Syn_Declarations (PP.wrap_Declarations (PP.sem_Declarations decls) PP.Inh_Declarations)) + UHA_Def name -> OneLineText (show name) + +descriptionOfSource :: UHA_Source -> String +descriptionOfSource source = + case source of + UHA_Expr _ -> "expression" + UHA_Pat _ -> "pattern" + UHA_Stat _ -> "statement" + UHA_Qual _ -> "qualifier" + UHA_FB _ -> "function binding" + UHA_RHS _ -> "right-hand side" + UHA_Decl _ -> "declaration" + UHA_Decls _ -> "declarations" + UHA_Def _ -> "definition" + +nameToUHA_Expr :: Name -> UHA_Source +nameToUHA_Expr name = UHA_Expr (Expression_Variable (getNameRange name) name) + +nameToUHA_Pat :: Name -> UHA_Source +nameToUHA_Pat name = UHA_Pat (Pattern_Variable (getNameRange name) name) + +nameToUHA_Def :: Name -> UHA_Source +nameToUHA_Def = UHA_Def + +convertSources :: (UHA_Source, Maybe UHA_Source) -> [(String, UHA_Source)] +convertSources (source, maybeSource) = + (descriptionOfSource source, source) : maybe [] (\s -> [(f s, s)]) maybeSource + where + f (UHA_Expr (Expression_Variable _ name)) + | isConstructor name = "constructor" + | isOperatorName name = "operator" + f (UHA_Expr (Expression_Constructor _ name)) + | isConstructor name = "constructor" + f (UHA_Pat (Pattern_Variable _ name)) + | isConstructor name = "constructor" + f _ = "term" diff --git a/src/Helium/StaticAnalysis/StaticChecks/Collect.ag b/src/Helium/StaticAnalysis/StaticChecks/Collect.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/StaticChecks/Collect.ag @@ -0,0 +1,236 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Collect the following information: +-- +-- 1) type constructors from a data type +-- 2) type synonyms +-- 3) (value) constructors from a data type +-- 4) fixity declarations +-- +-- Distribute the collected environments +-- 5) value constructors +-- 6) type constructors +-- 7) type synonyms +------------------------------------------------------------------------------- + +SEM Module + | Module loc . collectEnvironment = setValueConstructors (M.fromList @body.collectValueConstructors) + . setTypeConstructors (M.fromList @body.collectTypeConstructors) + . setTypeSynonyms (M.fromList @body.collectTypeSynonyms) + . setOperatorTable (M.fromList @body.operatorFixities) + . addToTypeEnvironment (M.fromList @derivedFunctions) + -- . setClassEnvironment @derivedInstances + $ emptyEnvironment + -- the type environment will be added after type inferencing. + . derivedFunctions = let f (n,i) = ( nameOfShowFunction n + , typeOfShowFunction n (take i [ nameFromString s | s <- variableList]) + ) + g (n,(i,_)) = f (n,i) + in map f @body.collectTypeConstructors ++ + map g @body.collectTypeSynonyms + +{- + . derivedInstances = let f (n,i) = makeInstance "Show" i (show n) + g (n,(i,_)) = f (n,i) + in unitFM "Show" + ( [] + , map f @body.collectTypeConstructors ++ + map g @body.collectTypeSynonyms + ) + +-} + +------------------------------------------- +-- 1) Collecting (data-)type constructors + +ATTR Body Declarations Declaration [ | collectTypeConstructors : {[(Name,Int)]} | ] + +SEM Module | Module body . collectTypeConstructors = [] + +SEM Declaration + | Data lhs . collectTypeConstructors = (@simpletype.name,length @simpletype.typevariables) : @lhs.collectTypeConstructors + +------------------------------------------- +-- 2) Collecting value constructors + +ATTR Body Declarations Declaration Constructors Constructor [ | collectValueConstructors : {[(Name,TpScheme)]} | ] +ATTR Constructor Constructors [ | | parameterTypes USE { ++ } { [] } : Tps ] + +SEM Module | Module body . collectValueConstructors = [] + +SEM Constructor + | Constructor + lhs . collectValueConstructors = (@constructor.self, @typeScheme) : @lhs.collectValueConstructors + . parameterTypes = @tps + loc . typeScheme = generalizeAll ([] .=>. foldr (.->.) @tp @tps) + . (tp,tps) = convertFromSimpleTypeAndTypes @lhs.simpletype @types.types + + | Infix + lhs . collectValueConstructors = (@constructorOperator.self, @typeScheme) : @lhs.collectValueConstructors + . parameterTypes = @tps + loc . typeScheme = generalizeAll ([] .=>. foldr (.->.) @tp @tps) + . (tp,tps) = convertFromSimpleTypeAndTypes @lhs.simpletype [@leftType.type,@rightType.type] + +------------------------------------------- +-- 3) Collecting type synonyms + +ATTR Body Declarations Declaration [ | collectTypeSynonyms : {[(Name,(Int,Tps -> Tp))]} | ] + +SEM Module | Module body . collectTypeSynonyms = [] + +SEM Declaration + | Type lhs . collectTypeSynonyms = (@simpletype.name, @typeSynonymInfo) : @lhs.collectTypeSynonyms + loc . typeSynonymInfo = (length @simpletype.typevariables,\tps -> makeTpFromType (zip @simpletype.typevariables tps) @type.self) + +------------------------------------------- +-- 4) Collecting Fixity Declarations + +ATTR Body Declarations Declaration [ | operatorFixities : {[(Name,(Int,Assoc))]} | ] + +SEM Module | Module body . operatorFixities = [] + +SEM Declaration + | Fixity lhs . operatorFixities = let associativity = case @fixity.self of + Fixity_Infix _ -> AssocNone + Fixity_Infixl _ -> AssocLeft + Fixity_Infixr _ -> AssocRight + priority = case @priority.self of + MaybeInt_Just i -> i + MaybeInt_Nothing -> 9 + in [ (name, (priority, associativity)) | name <- @operators.self ] ++ @lhs.operatorFixities + +------------------------------------------- +-- 5) Distributing Value Constructors + +SEM Module + | Module loc . (uniqueValueConstructors,duplicatedValueConstructors) = + uniqueKeys ( @body.collectValueConstructors + ++ concatMap (M.assocs . valueConstructors) @lhs.importEnvironments + ) + . allValueConstructors = map fst @uniqueValueConstructors ++ map head @duplicatedValueConstructors + . valueConstructors = M.fromList @uniqueValueConstructors + +ATTR Body Declarations Declaration Expressions Expression Patterns Pattern + Statement Statements Qualifier Qualifiers + Alternative Alternatives Constructor Constructors + GuardedExpressions GuardedExpression FunctionBinding FunctionBindings + LeftHandSide RightHandSide MaybeDeclarations MaybeExpression AnnotatedType AnnotatedTypes + [ valueConstructors : {M.Map Name TpScheme} allValueConstructors : Names | | ] + +------------------------------------------- +-- 6) Distributing Type Constructors + +SEM Module + | Module loc . (uniqueTypeConstructors,duplicatedTypeConstructors) = + uniqueKeys ( @body.collectTypeConstructors + ++ concatMap (M.assocs . typeConstructors) @lhs.importEnvironments + ++ [ (n,i) | (n,(i,_)) <- @body.collectTypeSynonyms ] + ) + . allTypeConstructors = map fst @uniqueTypeConstructors ++ map head @duplicatedTypeConstructors + . typeConstructors = M.fromList @uniqueTypeConstructors + +ATTR Body Declarations Declaration Expressions Expression Patterns Pattern + Statement Statements Qualifier Qualifiers + Alternative Alternatives Constructor Constructors + GuardedExpressions GuardedExpression FunctionBinding FunctionBindings + LeftHandSide RightHandSide MaybeDeclarations MaybeExpression + Type Types AnnotatedType AnnotatedTypes ContextItem ContextItems + [ typeConstructors : {M.Map Name Int} allTypeConstructors : Names | | ] + +------------------------------------------- +-- 7) Distributing Type Synonyms + +ATTR Module -> Declaration [ orderedTypeSynonyms:OrderedTypeSynonyms | | ] + +SEM Module + | Module body . orderedTypeSynonyms = + let list = concatMap (M.assocs . typeSynonyms) @lhs.importEnvironments ++ + @body.collectTypeSynonyms + newmap = M.fromList [ (show name, t) | (name, t) <- list ] + ordering = fst (getTypeSynonymOrdering newmap) + in (ordering, newmap) + +-------------------------------- +-- Derived instances (see also TypeInferenceCollect.ag) + +ATTR Module -> Declaration [ classEnvironment:ClassEnvironment | | collectInstances USE { ++ } { [] } : {[(Name, Instance)]} ] + +SEM Module + | Module + body.classEnvironment = + let importEnv = foldr combineImportEnvironments emptyEnvironment @lhs.importEnvironments + in foldr (\(n, i) -> insertInstance (show n) i) + (createClassEnvironment importEnv) + @body.collectInstances + +SEM Declaration + | Data + lhs . collectInstances = [ (cl, makeInstance (show cl) (length @simpletype.typevariables) (show @simpletype.name) ) + | cl <- @derivings.self + ] + + +------------------------------------------------------- +-- utility attributes for types and constructors + +ATTR SimpleType [ | | name:Name typevariables:Names ] + +SEM SimpleType + | SimpleType lhs . name = @name.self + . typevariables = @typevariables.self + +ATTR Type Types AnnotatedTypes AnnotatedType Constructors Constructor [ | | typevariables USE { ++ } { [] } : Names ] + +SEM Type + | Variable lhs . typevariables = [ @name.self ] + +ATTR Constructors Constructor [ simpletype:SimpleType | | ] + +SEM Declaration + | Data constructors . simpletype = @simpletype.self + | Newtype constructor . simpletype = @simpletype.self + +ATTR AnnotatedTypes [ | | types : Types ] +ATTR AnnotatedType [ | | type : Type ] + +SEM AnnotatedTypes + | Cons lhs . types = @hd.type : @tl.types + | Nil lhs . types = [] + +SEM AnnotatedType + | AnnotatedType lhs . type = @type.self + +{ +uniqueKeys :: Ord key => [(key,a)] -> ([(key,a)],[[key]]) +uniqueKeys = let comp (x,_) (y,_) = compare x y + eq (x,_) (y,_) = x == y + predicate xs = length xs == 1 + in (\(xs, ys) -> (map head xs, map (map fst) ys)) + . partition predicate + . groupBy eq + . sortBy comp +} + +------------------------------------------- +-- Collecting Type Signatures + +ATTR Declaration Declarations [ | typeSignatures:{[(Name,TpScheme)]} | ] +ATTR Body [ | | typeSignatures:{[(Name,TpScheme)]} ] + +SEM Body + | Hole lhs . typeSignatures = [] + | Body declarations . typeSignatures = [] +SEM Expression | Let declarations . typeSignatures = [] +SEM Statement | Let declarations . typeSignatures = [] +SEM Qualifier | Let declarations . typeSignatures = [] +SEM MaybeDeclarations | Just declarations . typeSignatures = [] + +SEM Declaration + | TypeSignature + lhs . typeSignatures = [ (name, @typeScheme) | name <- @names.self ] ++ @lhs.typeSignatures + loc . (typeScheme, intMap) = makeTpSchemeFromType' @type.self diff --git a/src/Helium/StaticAnalysis/StaticChecks/ExportErrors.ag b/src/Helium/StaticAnalysis/StaticChecks/ExportErrors.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/StaticChecks/ExportErrors.ag @@ -0,0 +1,81 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- !!! CLEAN UP THIS CODE !!! +-- +------------------------------------------------------------------------------- + +{- +SEM Export + | TypeOrClassComplete + lhs . errors = checkExport ExportTypeConstructor @name.self + @lhs.tyconsInScope + | TypeOrClass lhs . errors = checkExport ExportTypeConstructor @name.self + @lhs.tyconsInScope + ++ + concatMap + (\name -> + checkExport ExportConstructor name + @lhs.consInScope + ) + @names.toList +-} +SEM Module + | Module exports . namesInScop = concat [ @body.declVarNames + , concatMap (M.keys . typeEnvironment) @lhs.importEnvironments + , map fst @derivedFunctions + ] + . modulesInScope = (@moduleName : @fileName : @body.importedModules) + . tyconsInScope = @allTypeConstructors + . consInScope = @allValueConstructors + +SEM Module + | Module loc . exportErrors = @exports.exportErrors + +ATTR MaybeExports Exports Export + [ namesInScop : Names + modulesInScope : Names + tyconsInScope : Names + consInScope : Names + | + | exportErrors USE { ++ } { [] } : {[Error]} + ] + +{ + +checkExport :: Entity -> Name -> [Name] -> [Error] +checkExport entity name inScope = + makeUndefined entity + (if name `elem` inScope then + [] + else + [name] + ) + (nubBy equalName inScope) + +equalName :: Name -> Name -> Bool +equalName x y = + getNameName x == getNameName y +} + +SEM Export + | Variable lhs . exportErrors = checkExport ExportVariable @name.self + @lhs.namesInScop + | Module lhs . exportErrors = checkExport ExportModule @name.self + @lhs.modulesInScope +------------------------------------------- +-- Collecting the imported modules + +ATTR ImportDeclarations ImportDeclaration [ | importedModules : Names | ] +ATTR Body [ | | importedModules : Names ] + +SEM Body + | Hole lhs . importedModules = [] + | Body importdeclarations . importedModules = [] + +SEM ImportDeclaration + | Import lhs . importedModules = @name.self : @lhs.importedModules diff --git a/src/Helium/StaticAnalysis/StaticChecks/HeliumPartialSyntax.ag b/src/Helium/StaticAnalysis/StaticChecks/HeliumPartialSyntax.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/StaticChecks/HeliumPartialSyntax.ag @@ -0,0 +1,51 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Because not everything defined in UHA is permitted +-- within the Helium language, some non-terminals should never occur. +-- Furthermore, some type of declarations should only occur at top-level. +-- This module prevents warnings by the AG-system. +-- +------------------------------------------------------------------------------- + +SEM Declaration + | Instance loc . (assumptions,constraints,unboundNames) = internalError "PartialSyntax.ag" "n/a" "Declaration.Instance" + | Class loc . (assumptions,constraints,unboundNames) = internalError "PartialSyntax.ag" "n/a" "Declaration.Class" + +SEM Expression + | RecordConstruction loc . (assumptions,constraints,beta) = internalError "PartialSyntax.ag" "n/a" "Expression.RecordConstruction" + +SEM Pattern + | Record loc . (beta,constraints,environment) = internalError "PartialSyntax.ag" "n/a" "Pattern.Record" + | Successor loc . (beta,constraints,environment) = internalError "PartialSyntax.ag" "n/a" "Pattern.Successor" + +SEM RecordExpressionBinding + | RecordExpressionBinding loc . (monos,constructorenv,betaUnique,miscerrors,warnings,kindErrors,valueConstructors,allValueConstructors,typeConstructors,allTypeConstructors,importEnvironment) = internalError "PartialSyntax.ag" "n/a" "RecordExpressionBinding.RecordExpressionBinding" + +SEM RecordPatternBinding + | RecordPatternBinding loc . (monos,constructorenv,betaUnique,miscerrors,warnings,valueConstructors,allValueConstructors,typeConstructors,allTypeConstructors,importEnvironment) = internalError "PartialSyntax.ag" "n/a" "RecordPatternBinding.RecordPatternBinding" + +SEM FieldDeclaration + | FieldDeclaration loc . (kindErrors,tyconEnv,constructorenv,importEnvironment,valueConstructors,allValueConstructors,typeConstructors,allTypeConstructors,warnings) = internalError "PartialSyntax.ag" "n/a" "FieldDeclaration.FieldDeclaration" + +SEM ContextItem + | ContextItem loc . (tyconEnv) = internalError "PartialSyntax.ag" "n/a" "ContextItem.ContextItem" + +------------------------------------------------------------------------------------------ +-- Attributes that are only used at top-level + +SEM Statement + | Let loc . (collectTypeConstructors,collectValueConstructors,collectTypeSynonyms,collectConstructorEnv,derivedFunctions,operatorFixities) = internalError "PartialSyntax.ag" "n/a" "toplevel Statement" + +SEM Expression + | Let loc . (collectTypeConstructors,collectValueConstructors,collectTypeSynonyms,collectConstructorEnv,derivedFunctions,operatorFixities) = internalError "PartialSyntax.ag" "n/a" "toplevel Expression" + +SEM MaybeDeclarations + | Just loc . (collectTypeConstructors,collectValueConstructors,collectTypeSynonyms,collectConstructorEnv,derivedFunctions,operatorFixities) = internalError "PartialSyntax.ag" "n/a" "toplevel MaybeDeclaration" + +SEM Qualifier + | Let loc . (collectTypeConstructors,collectValueConstructors,collectTypeSynonyms,collectConstructorEnv,derivedFunctions,operatorFixities) = internalError "PartialSyntax.ag" "n/a" "toplevel Qualifier" diff --git a/src/Helium/StaticAnalysis/StaticChecks/KindChecking.ag b/src/Helium/StaticAnalysis/StaticChecks/KindChecking.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/StaticChecks/KindChecking.ag @@ -0,0 +1,103 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- A kind checker for Helium. +-- +-- Note: Kind Inferencing for the Helium language is pretty straightforward: check +-- if each type constructor has the right number of arguments, and whether +-- no types are applied to a type variable. +-- +------------------------------------------------------------------------------- + +ATTR Declarations MaybeDeclarations Declaration + Expression Expressions MaybeExpression GuardedExpression GuardedExpressions + Statement Statements Qualifier Qualifiers + Alternative Alternatives + Body RightHandSide FunctionBinding FunctionBindings + Constructor Constructors AnnotatedTypes AnnotatedType + [ | kindErrors : {[Error]} | ] + +SEM Module + | Module body . kindErrors = [] + loc . kindErrors = @body.kindErrors + +SEM Expression + | Typed lhs . kindErrors = @newErrors ++ @expression.kindErrors + loc . newErrors = checkType @lhs.typeConstructors (@lhs.namesInScope ++ @lhs.allValueConstructors) @type.self + +SEM Declaration + | Type lhs . kindErrors = @newErrors ++ @lhs.kindErrors + loc . newErrors = checkType @lhs.typeConstructors (@lhs.namesInScope ++ @lhs.allValueConstructors) @type.self + + | TypeSignature lhs . kindErrors = @newErrors ++ @lhs.kindErrors + loc . newErrors = checkType @lhs.typeConstructors (@lhs.namesInScope ++ @lhs.allValueConstructors) @type.self + +SEM AnnotatedType + | AnnotatedType lhs . kindErrors = @newErrors ++ @lhs.kindErrors + loc . newErrors = checkType @lhs.typeConstructors (@lhs.namesInScope ++ @lhs.allValueConstructors) @type.self + +{ +checkType :: M.Map Name Int -> Names -> Type -> [Error] +checkType theTypeConstructors namesInScope t = + let (f, xs) = walkSpine t + xsErrors = concatMap (checkType theTypeConstructors namesInScope) xs + in + xsErrors + ++ + case f of + Type_Constructor r c -> + checkKind c theTypeConstructors (length xs) namesInScope + ++ [ TupleTooBig r + | let nameAsString = show c + , isTupleConstructor nameAsString + , length nameAsString - 1 > 10 + ] + Type_Variable _ v -> + if length xs /= 0 then + [ TypeVarApplication v ] + else + [] + _ -> + internalError "StaticAnalysis" "checkType" "unexpected type" + +walkSpine :: Type -> (Type, [Type]) +walkSpine t = + case t of + Type_Variable _ _ -> (t, []) + Type_Constructor _ _ -> (t, []) + Type_Application _ _ f xs -> + let (t', ys) = walkSpine f + in (t', ys ++ xs) + Type_Parenthesized _ t' -> walkSpine t' + Type_Qualified _ _ t' -> walkSpine t' + _ -> internalError "StaticAnalysis" "walkSpine" "unexpected type" + +checkKind :: Name -> M.Map Name Int -> Int -> Names -> [Error] +checkKind tycon@(Name_Special _ _ ('(':commas)) _ useArity _ = -- !!!Name + if expected == useArity then + [] + else + [ ArityMismatch TypeConstructor tycon expected useArity] + where + expected = + case length (takeWhile (== ',') commas) of + 0 -> 0 -- () + n -> n + 1 -- (,) (,,) ... + +checkKind tycon theTypeConstructors useArity namesInScope = + case M.lookup tycon theTypeConstructors of + Nothing -> + let hint = [ "Constructor "++show (show tycon)++" cannot be used in a type" + | tycon `elem` namesInScope + ] + in [ Undefined TypeConstructor tycon (M.keys theTypeConstructors) hint ] + Just defArity -> + if useArity /= defArity then + [ ArityMismatch TypeConstructor tycon defArity useArity ] + else + [ ] +} diff --git a/src/Helium/StaticAnalysis/StaticChecks/MiscErrors.ag b/src/Helium/StaticAnalysis/StaticChecks/MiscErrors.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/StaticChecks/MiscErrors.ag @@ -0,0 +1,286 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Miscellaneous errors +-- +------------------------------------------------------------------------------- + +ATTR Expression Expressions MaybeExpression Pattern Patterns Alternative Alternatives + Statement Statements Declaration Declarations MaybeDeclarations LeftHandSide RightHandSide + FunctionBinding FunctionBindings Body Qualifier Qualifiers + GuardedExpression GuardedExpressions Literal + Type Types AnnotatedTypes AnnotatedType ContextItem ContextItems Constructors Constructor FieldDeclaration + FieldDeclarations + [ | miscerrors : {[Error]} | ] + +SEM Module + | Module body . miscerrors = [] + loc . miscerrors = @body.miscerrors + +----------------------------------------- +-- Body + +SEM Body + | Body lhs . miscerrors = @typeSignatureErrors ++ @declarations.miscerrors + loc . typeSignatureErrors = checkTypeSignatures @declarations.declVarNames @declarations.restrictedNames @declarations.typeSignatures + +----------------------------------------- +-- Declaration + +SEM Declaration + | FunctionBindings lhs . miscerrors = @arityErrors ++ @bindings.miscerrors + loc . arityErrors = if all (== head @bindings.arities) @bindings.arities + then [] + else [ DefArityMismatch @bindings.name (mode @bindings.arities) @range.self ] + + | PatternBinding lhs . miscerrors = @patternDefinesNoVarsErrors ++ @righthandside.miscerrors + loc . patternDefinesNoVarsErrors = if null @pattern.patVarNames + then [ PatternDefinesNoVars (getPatRange @pattern.self) ] + else [] + + | Data lhs . miscerrors = concat [ makeDuplicated TypeVariable @doubles + , makeUndefined TypeVariable @undef @simpletype.typevariables + , @lhs.miscerrors + , @unknCls + , if null @unknCls then @cantDer else [] + ] + loc . unused = filter (`notElem` @constructors.typevariables) @simpletype.typevariables + . doubles = filter ((>1) . length) . group . sort $ @simpletype.typevariables + . undef = filter (`notElem` @simpletype.typevariables) @constructors.typevariables + . unknCls = [ if className `elem` [ "Num", "Enum", "Ord" ] + then NonDerivableClass c + else UnknownClass c + | c <- @derivings.self, let className = show c + , className `notElem` ["Show", "Eq"] + ] + . cantDer = [ CannotDerive c [ tp | ReductionError (Predicate _ tp) <- errs ] + | c <- @derivings.self + , let preds = map (Predicate (show c)) @constructors.parameterTypes + (_, errs) = contextReduction @lhs.orderedTypeSynonyms @lhs.classEnvironment preds + , not (null errs) + ] + + | Type lhs . miscerrors = concat [ makeDuplicated TypeVariable @doubles + , makeUndefined TypeVariable @undef @simpletype.typevariables + , @lhs.miscerrors + ] + loc . unused = filter (`notElem` @type.typevariables) @simpletype.typevariables + . doubles = filter ((>1) . length) . group . sort $ @simpletype.typevariables + . undef = filter (`notElem` @simpletype.typevariables) @type.typevariables + +SEM MaybeDeclarations + | Just lhs . miscerrors = @typeSignatureErrors ++ @declarations.miscerrors + loc . (_,doubles) = uniqueAppearance (map fst @declarations.typeSignatures) + loc . typeSignatureErrors = checkTypeSignatures @declarations.declVarNames @declarations.restrictedNames @declarations.typeSignatures + +{- utility attribute: collecting the arities of the function bindings -} +ATTR FunctionBindings [ | | arities : { [Int] } ] +ATTR FunctionBinding [ | | arity : Int ] + +SEM FunctionBindings + | Cons lhs.arities = @hd.arity : @tl.arities + | Nil lhs.arities = [] + +SEM FunctionBinding + | Hole lhs . arity = 0 + | FunctionBinding lhs . arity = @lefthandside.numberOfPatterns + +{- utility attribute: is the last statement an expression? -} +ATTR Statements Statement [ | lastStatementIsExpr : Bool | ] + +SEM Expression + | Do statements . lastStatementIsExpr = False + +SEM Statement + | Expression lhs . lastStatementIsExpr = True + | Generator lhs . lastStatementIsExpr = False + | Let lhs . lastStatementIsExpr = False + +{ +mode :: Ord a => [a] -> Maybe a -- Just ... IF any of the elements is more common +mode xs = + case filter ((== maxFreq) . snd) fs of + [(x, _)] -> Just x + _ -> Nothing + where + maxFreq = maximum (map snd fs) + fs = frequencies xs + +frequencies :: Ord a => [a] -> [(a, Int)] +frequencies = map (\ys -> (head ys, length ys)) . group . sort +} + +----------------------------------------- +-- Expression + +SEM Expression + | Variable lhs . miscerrors = @undefinedErrors ++ @lhs.miscerrors + loc . undefinedErrors = if @name.self `elem` @lhs.namesInScope + then [] + else [ Undefined Variable @name.self @lhs.namesInScope [] ] + | Do lhs . miscerrors = @lastStatementErrors ++ @statements.miscerrors + loc . lastStatementErrors = if @statements.lastStatementIsExpr + then [] + else let range = getStatementRange (last @statements.self) + in [ LastStatementNotExpr range ] + + | Constructor lhs . miscerrors = @undefinedConstructorErrors ++ @lhs.miscerrors + loc . undefinedConstructorErrors = case M.lookup @name.self @lhs.valueConstructors of + Nothing -> [ undefinedConstructorInExpr @name.self (@lhs.namesInScope ++ @lhs.allValueConstructors) @lhs.allTypeConstructors ] + Just _ -> [] + + | Let lhs . miscerrors = @typeSignatureErrors ++ @expression.miscerrors + loc . (_,doubles) = uniqueAppearance (map fst @declarations.typeSignatures) + loc . typeSignatureErrors = checkTypeSignatures @declarations.declVarNames @declarations.restrictedNames @declarations.typeSignatures + + | Tuple lhs . miscerrors = @tupleTooBigErrors ++ @expressions.miscerrors + loc . tupleTooBigErrors = + [ TupleTooBig @range.self + | length @expressions.self > 10 + ] + +----------------------------------------- +-- Pattern + +SEM Pattern + | Constructor lhs . miscerrors = @patConstructorErrors ++ @patterns.miscerrors + loc . patConstructorErrors = patternConstructorErrors @maybetp @name.self @lhs.allValueConstructors @patterns.numberOfPatterns @lhs.lhsPattern @lhs.allTypeConstructors + . maybetp = M.lookup @name.self @lhs.valueConstructors + + | InfixConstructor lhs . miscerrors = @patConstructorErrors ++ @rightPattern.miscerrors + loc . patConstructorErrors = patternConstructorErrors @maybetp @constructorOperator.self @lhs.allValueConstructors 2 False @lhs.allTypeConstructors + . maybetp = M.lookup @constructorOperator.self @lhs.valueConstructors + + +{ +patternConstructorErrors :: Maybe TpScheme -> Name -> Names -> Int -> Bool -> Names -> [Error] +patternConstructorErrors maybetparity name env useArity lhsPattern namesTyconEnv = + case maybetparity of + Nothing -> + [ undefinedConstructorInPat lhsPattern name env namesTyconEnv ] + Just tpScheme -> + let arity = arityOfTpScheme tpScheme + in if arity /= useArity + then [ ArityMismatch Constructor name arity useArity ] + else [] +} + +ATTR Patterns Pattern [ lhsPattern : Bool | | ] + +SEM Declaration | PatternBinding pattern . lhsPattern = simplePattern @pattern.self + +SEM Pattern | Constructor patterns . lhsPattern = False +SEM Expression | Lambda patterns . lhsPattern = False +SEM Alternative | Alternative pattern . lhsPattern = False +SEM Statement | Generator pattern . lhsPattern = False +SEM Qualifier | Generator pattern . lhsPattern = False +SEM LeftHandSide | Infix leftPattern . lhsPattern = False + rightPattern . lhsPattern = False + | Function patterns . lhsPattern = False + | Parenthesized patterns . lhsPattern = False + +SEM RecordPatternBinding | RecordPatternBinding pattern . lhsPattern = False + +{ +simplePattern :: Pattern -> Bool +simplePattern pattern = + case pattern of + Pattern_Constructor _ name _ -> case show name of + x:_ -> isUpper x + _ -> False + _ -> False +} + +----------------------------------------- +-- Statement + + SEM Statement + | Let lhs . miscerrors = @typeSignatureErrors ++ @declarations.miscerrors + loc . (_,doubles) = uniqueAppearance (map fst @declarations.typeSignatures) + . typeSignatureErrors = checkTypeSignatures @declarations.declVarNames @declarations.restrictedNames @declarations.typeSignatures + +----------------------------------------- +-- Qualifier + +SEM Qualifier + | Let lhs . miscerrors = @typeSignatureErrors ++ @declarations.miscerrors + loc . (_,doubles) = uniqueAppearance (map fst @declarations.typeSignatures) + . typeSignatureErrors = checkTypeSignatures @declarations.declVarNames @declarations.restrictedNames @declarations.typeSignatures + +{ +-- Type signature but no function definition +-- Duplicated type signatures +-- Overloaded type scheme for a restricted pattern +checkTypeSignatures :: Names -> Names -> [(Name,TpScheme)] -> Errors +checkTypeSignatures declVarNames restrictedNames xs = + let (unique, doubles) = uniqueAppearance (map fst xs) + in [ Duplicated TypeSignature names + | names <- doubles + ] + ++ [ NoFunDef TypeSignature name declVarNames + | name <- unique + , name `notElem` declVarNames + ] + ++ [ OverloadedRestrPat name + | (name, scheme) <- xs + , name `elem` unique + , name `elem` restrictedNames + , isOverloaded scheme + ] +} + +----------------------------------------- +-- Literal + +SEM Literal + | Int loc . intLiteralTooBigErrors = + let val = read @value :: Integer in + if length @value > 9 && (val > maxInt || val < minInt) then + [ IntLiteralTooBig @range.self @value ] + else + [] + lhs . miscerrors = @intLiteralTooBigErrors ++ @lhs.miscerrors + +-- Qualified types + +SEM Type -- does every type variable in the contexts appear in the type? + | Qualified lhs.miscerrors = + ( if Overloading `elem` @lhs.options then + [ AmbiguousContext v | v <- @context.contextVars, v `notElem` @type.typevariables ] + else + [ OverloadingDisabled @range.self ] + ) + ++ + @type.miscerrors + +ATTR ContextItems ContextItem [ | | contextVars USE { ++ } { [] } : {[Name]} ] + +SEM ContextItem + | ContextItem lhs.contextVars = @types.typevariables + lhs.miscerrors = if elem (getNameName @name.self) (M.keys standardClasses) + then @types.miscerrors + else UnknownClass @name.self : @types.miscerrors + +-- context for restricted pattern error +ATTR Declaration Declarations [ | | restrictedNames USE { ++ } { [] } : Names ] + +SEM Declaration + | PatternBinding + lhs . restrictedNames = if isSimplePattern @pattern.self + then [] + else @pattern.patVarNames + +{ +isSimplePattern :: Pattern -> Bool +isSimplePattern pattern = + case pattern of + Pattern_Variable _ _ -> True + Pattern_Parenthesized _ p -> isSimplePattern p + _ -> False +} + + diff --git a/src/Helium/StaticAnalysis/StaticChecks/Scope.ag b/src/Helium/StaticAnalysis/StaticChecks/Scope.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/StaticChecks/Scope.ag @@ -0,0 +1,182 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- All variables (of type Name) are determined that are in +-- scope (for each location in the abstract syntax tree) +-- +-- Variables can be added to the scope by three ways: +-- +-- 1) externally defefined, imported, or primitive +-- Module.Module +-- +-- 2) introduced in a binding-group (nodes with "Declarations") +-- Body.Body +-- MaybeDeclarations.Just +-- Expression.Let +-- Statement.Let +-- Qualifier.Let +-- +-- 3) introduced in a pattern that is not part of a binding-group; these +-- variables are automatically monomorphic. (nodes with "Pattern" +-- or "Patterns") +-- FunctionBinding.FunctionBinding +-- Expression.Lambda +-- Alternative.Alternative +-- Statement.Generator +-- Qualifier.Generator +-- +-- The scope simply follows the shape of the abstract syntax tree, except for +-- Statements, Qualifiers en RightHandSide (where). +-- +------------------------------------------------------------------------------- + +ATTR Expression RightHandSide + RecordExpressionBinding RecordExpressionBindings + MaybeExpression GuardedExpression FunctionBinding + Expressions Declaration Declarations Alternative FunctionBindings + Alternatives GuardedExpressions RecordPatternBinding + Patterns Pattern LeftHandSide RecordPatternBindings AnnotatedType + AnnotatedTypes Constructor Constructors FieldDeclaration FieldDeclarations Body + [ namesInScope : Names | counter : Int | unboundNames USE {++} {[]} : Names ] + +SEM Module + | Module loc . (namesInScope, unboundNames, scopeInfo) = changeOfScope (@initialScope ++ @body.declVarNames) @body.unboundNames [] + body . counter = 0 + +SEM MaybeDeclarations + | Just loc . (namesInScope, unboundNames, scopeInfo) = changeOfScope @declarations.declVarNames (@declarations.unboundNames ++ @lhs.unboundNames) @lhs.namesInScope + lhs . unboundNames = @unboundNames -- not a copy-rule for my ag-compiler! + +SEM Expression + | Let loc . (namesInScope, unboundNames, scopeInfo) = changeOfScope @declarations.declVarNames (@declarations.unboundNames ++ @expression.unboundNames) @lhs.namesInScope + lhs . unboundNames = @unboundNames -- not a copy-rule for my ag-compiler! + +SEM Statement + | Let loc . (namesInScope, unboundNames, scopeInfo) = changeOfScope @declarations.declVarNames (@declarations.unboundNames ++ @lhs.unboundNames) @lhs.namesInScope + +SEM Qualifier + | Let loc . (namesInScope, unboundNames, scopeInfo) = changeOfScope @declarations.declVarNames (@declarations.unboundNames ++ @lhs.unboundNames) @lhs.namesInScope + +-- monomorphic binding constructs + +SEM FunctionBinding + | FunctionBinding loc . (namesInScope, unboundNames, scopeInfo) = changeOfScope @lefthandside.patVarNames @righthandside.unboundNames @lhs.namesInScope + lhs . unboundNames = @unboundNames -- not a copy-rule for my ag-compiler! + +SEM Expression + | Lambda loc . (namesInScope, unboundNames, scopeInfo) = changeOfScope @patterns.patVarNames @expression.unboundNames @lhs.namesInScope + lhs . unboundNames = @unboundNames -- not a copy-rule for my ag-compiler! + -- | Hole lhs . namesInScope = @namesInScope + + +SEM Alternative + | Alternative loc . (namesInScope, unboundNames, scopeInfo) = changeOfScope @pattern.patVarNames @righthandside.unboundNames @lhs.namesInScope + lhs . unboundNames = @unboundNames -- not a copy-rule for my ag-compiler! + +SEM Statement + | Generator loc . (namesInScope, unboundNames, scopeInfo) = changeOfScope @pattern.patVarNames (@expression.unboundNames ++ @lhs.unboundNames) @lhs.namesInScope + +SEM Qualifier + | Generator loc . (namesInScope, unboundNames, scopeInfo) = changeOfScope @pattern.patVarNames (@expression.unboundNames ++ @lhs.unboundNames) @lhs.namesInScope + +-- correct scope for RightHandSides (where) + +ATTR MaybeDeclarations [ | counter : Int unboundNames : Names namesInScope : Names | ] + +SEM RightHandSide + | Expression lhs . unboundNames = @where.unboundNames + expression . namesInScope = @where.namesInScope + where . unboundNames = @expression.unboundNames + | Guarded lhs . unboundNames = @where.unboundNames + guardedexpressions . namesInScope = @where.namesInScope + where . unboundNames = @guardedexpressions.unboundNames + +-- correct scope for Statements/Qualifiers + +ATTR Statements Statement Qualifier Qualifiers [ | counter : Int namesInScope : Names unboundNames : Names | ] + +SEM Expression + | Do statements . unboundNames = [] + +SEM Statement + | Generator lhs . namesInScope = @namesInScope + . unboundNames = @unboundNames + expression . namesInScope = @lhs.namesInScope + | Let lhs . unboundNames = @unboundNames + | Expression lhs . unboundNames = @expression.unboundNames ++ @lhs.unboundNames + +SEM Statements + | Cons lhs . unboundNames = @hd.unboundNames + tl . unboundNames = @lhs.unboundNames + hd . unboundNames = @tl.unboundNames + | Nil lhs . unboundNames = @lhs.unboundNames + +SEM Expression + | Comprehension lhs . unboundNames = @qualifiers.unboundNames + expression . namesInScope = @qualifiers.namesInScope + qualifiers . namesInScope = @lhs.namesInScope + . unboundNames = @expression.unboundNames + +SEM Qualifier + | Generator lhs . namesInScope = @namesInScope + . unboundNames = @unboundNames + expression . namesInScope = @lhs.namesInScope + | Let lhs . unboundNames = @unboundNames + | Guard lhs . unboundNames = @guard.unboundNames ++ @lhs.unboundNames + +SEM Qualifiers + | Cons lhs . unboundNames = @hd.unboundNames + tl . unboundNames = @lhs.unboundNames + hd . unboundNames = @tl.unboundNames + | Nil lhs . unboundNames = @lhs.unboundNames + +------------------------------------------------------------------------------------- + +ATTR Pattern Patterns + LeftHandSide [ | | patVarNames USE {++} {[]} : Names ] + +SEM Pattern + | Variable lhs . patVarNames = [ @name.self ] + | As lhs . patVarNames = @name.self : @pattern.patVarNames + | Hole lhs . patVarNames = [ Name_Special noRange [] ("hole" ++ show @loc.i) ] + loc . i : UNIQUEREF counter + +SEM Expression + | Variable lhs . unboundNames = [ @name.self ] + +ATTR Body Declaration Declarations [ | | declVarNames USE {++} {[]} : Names ] + +SEM Declaration + | FunctionBindings lhs . declVarNames = [@bindings.name] + | PatternBinding lhs . declVarNames = @pattern.patVarNames + +-- utility function +{ +type ScopeInfo = ( [Names] -- duplicated variables + , [Name] -- unused variables + , [(Name, Name)] -- shadowed variables + ) + +changeOfScope :: Names -> Names -> Names -> (Names, Names, ScopeInfo) +changeOfScope names unboundNames namesInScope = + let (uniqueNames, duplicatedNames) = uniqueAppearance names + unusedNames = uniqueNames \\ unboundNames + shadowedNames = let f n = [ (n, n') | n' <- namesInScope, n == n' ] + in concatMap f uniqueNames + in ( uniqueNames ++ map head duplicatedNames ++ (namesInScope \\ names) + , unboundNames \\ names + , (duplicatedNames, unusedNames, shadowedNames) + ) + +uniqueAppearance :: Ord a => [a] -> ([a],[[a]]) +uniqueAppearance = Prelude.foldr myInsert ([],[]) . group . sort + where myInsert [x] (as,bs) = (x:as,bs) + myInsert xs (as,bs) = (as,xs:bs) + +nextUnique :: Num a => a -> (a, a) +nextUnique n = (n+1, n) +} diff --git a/src/Helium/StaticAnalysis/StaticChecks/ScopeErrors.ag b/src/Helium/StaticAnalysis/StaticChecks/ScopeErrors.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/StaticChecks/ScopeErrors.ag @@ -0,0 +1,58 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Scope errors. +-- +----------------------------------------------------------------------------- + +ATTR Expression Expressions MaybeExpression Pattern Patterns Alternative Alternatives + Statement Statements Declaration Declarations MaybeDeclarations LeftHandSide RightHandSide + FunctionBinding FunctionBindings Body Qualifier Qualifiers + GuardedExpression GuardedExpressions Literal RecordExpressionBinding RecordPatternBinding + RecordExpressionBindings RecordPatternBindings + [ | collectScopeInfos : {[(ScopeInfo, Entity)]} | ] + +SEM Module + | Module body . collectScopeInfos = [] + loc . scopeErrors = makeErrors @collectScopeInfos + . scopeWarnings = makeWarnings @collectScopeInfos + +SEM Module + | Module loc . collectScopeInfos = (topLevelScopeInfo @scopeInfo, Definition) : @body.collectScopeInfos + +SEM FunctionBinding + | FunctionBinding lhs . collectScopeInfos = (@scopeInfo, Variable) : @righthandside.collectScopeInfos + +SEM MaybeDeclarations + | Just lhs . collectScopeInfos = (@scopeInfo, Definition) : @declarations.collectScopeInfos + +SEM Expression + | Lambda lhs . collectScopeInfos = (@scopeInfo, Variable) : @expression.collectScopeInfos + | Let lhs . collectScopeInfos = (@scopeInfo, Definition) : @expression.collectScopeInfos + +SEM Alternative + | Alternative lhs . collectScopeInfos = (@scopeInfo, Variable) : @righthandside.collectScopeInfos + +SEM Statement + | Let lhs . collectScopeInfos = (@scopeInfo, Definition) : @declarations.collectScopeInfos + | Generator lhs . collectScopeInfos = (@scopeInfo, Variable) : @expression.collectScopeInfos + +SEM Qualifier + | Let lhs . collectScopeInfos = (@scopeInfo, Definition) : @declarations.collectScopeInfos + | Generator lhs . collectScopeInfos = (@scopeInfo, Variable) : @expression.collectScopeInfos + +{ +topLevelScopeInfo :: ScopeInfo -> ScopeInfo +topLevelScopeInfo (xs, _, _) = (xs, [], []) + +makeErrors :: [(ScopeInfo, Entity)] -> Errors +makeErrors xs = [ Duplicated entity ys | ((yss, _, _), entity) <- xs, ys <- yss ] + +makeWarnings :: [(ScopeInfo, Entity)] -> Warnings +makeWarnings xs = [ Unused entity name | ((_, names, _), entity) <- xs, name <- names ] + ++ [ Shadow n2 n1 | ((_, _, pairs), _) <- xs, (n1, n2) <- pairs ] +} diff --git a/src/Helium/StaticAnalysis/StaticChecks/StaticChecks.ag b/src/Helium/StaticAnalysis/StaticChecks/StaticChecks.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/StaticChecks/StaticChecks.ag @@ -0,0 +1,110 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- A static analyzer. The checks are defined in the included ag-modules. +-- +----------------------------------------------------------------------------- + +ATTR Module + [ baseName : String + importEnvironments : ImportEnvironments + options : {[Option]} + | + | collectEnvironment : ImportEnvironment + errors : Errors + typeSignatures : {[(Name,TpScheme)]} + warnings : Warnings + ] + +ATTR Module -> Type [ options : {[Option]} || ] + +INCLUDE "Collect.ag" +INCLUDE "UHA_Syntax.ag" +INCLUDE "Scope.ag" +INCLUDE "KindChecking.ag" +INCLUDE "Warnings.ag" +INCLUDE "TopLevelErrors.ag" +INCLUDE "MiscErrors.ag" +INCLUDE "ExportErrors.ag" +INCLUDE "HeliumPartialSyntax.ag" +INCLUDE "ScopeErrors.ag" + +imports { +import Helium.Utils.Similarity ( similar ) +import Helium.Main.Args +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils +import Helium.Syntax.UHA_Range +import Top.Types + +import Helium.StaticAnalysis.Messages.StaticErrors +import Helium.StaticAnalysis.Messages.Warnings +import Helium.StaticAnalysis.Messages.Messages +import Data.List +import Helium.Utils.Utils ( internalError, minInt, maxInt ) +import Helium.StaticAnalysis.Miscellaneous.TypeConversion +import Helium.CodeGeneration.DerivingShow + +import qualified Data.Map as M + +import Helium.ModuleSystem.ImportEnvironment +import Helium.Parser.OperatorTable +import Data.Char ( isUpper ) + +} + +-- combine all the collected errors, then filter out the "entity is undefined" +-- errors that are caused by the removal of "duplicated entities" +SEM Module + | Module lhs . errors = filter (\err -> filterRemovedNames @removedEntities err + && filterDerivedNames @derivedRanges err) @allErrors + . warnings = @scopeWarnings ++ @warnings + loc . allErrors = concat [ @exportErrors + , @scopeErrors + , @miscerrors + , if KindInferencing `elem` @lhs.options then [] else @kindErrors + , @topLevelErrors + ] + . removedEntities = [ (name,TypeConstructor) | name:_ <- @duplicatedTypeConstructors ] ++ + [ (name,Constructor ) | name:_ <- @duplicatedValueConstructors ] + . derivedRanges = map getNameRange (map fst @derivedFunctions) + . initialScope = map fst @derivedFunctions ++ + concatMap (M.keys . typeEnvironment) @lhs.importEnvironments +{ +-- filter undefined errors that are caused by the removal of a duplicate definition +filterRemovedNames :: [(Name,Entity)] -> Error -> Bool +filterRemovedNames list err = + case err of + Undefined entity name _ _ -> (name,entity) `notElem` list + _ -> True + +filterDerivedNames :: [Range] -> Error -> Bool +filterDerivedNames ranges err = + case err of + Duplicated Definition names -> any (`notElem` ranges) (map getNameRange names) + _ -> True +} + +ATTR FunctionBinding FunctionBindings LeftHandSide [ | | name:Name ] +ATTR Patterns LeftHandSide [ | | numberOfPatterns : Int ] + +SEM FunctionBindings + | Cons lhs . name = @hd.name + | Nil lhs . name = internalError "StaticChecks.ag" "n/a" "empty FunctionBindings" + +SEM FunctionBinding + | Hole lhs . name = internalError "StaticChecks.ag" "n/a" "empty FunctionBindings" + +SEM LeftHandSide + | Function lhs . name = @name.self + | Infix lhs . name = @operator.self + . numberOfPatterns = 2 + | Parenthesized lhs . numberOfPatterns = @lefthandside.numberOfPatterns + @patterns.numberOfPatterns + +SEM Patterns + | Cons lhs . numberOfPatterns = 1 + @tl.numberOfPatterns + | Nil lhs . numberOfPatterns = 0 diff --git a/src/Helium/StaticAnalysis/StaticChecks/StaticChecks.hs b/src/Helium/StaticAnalysis/StaticChecks/StaticChecks.hs new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/StaticChecks/StaticChecks.hs @@ -0,0 +1,17049 @@ +{-# LANGUAGE Rank2Types, GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Helium.StaticAnalysis.StaticChecks.StaticChecks where + +import Helium.Utils.Similarity ( similar ) +import Helium.Main.Args +import Helium.Syntax.UHA_Syntax +import Helium.Syntax.UHA_Utils +import Helium.Syntax.UHA_Range +import Top.Types + +import Helium.StaticAnalysis.Messages.StaticErrors +import Helium.StaticAnalysis.Messages.Warnings +import Helium.StaticAnalysis.Messages.Messages +import Data.List +import Helium.Utils.Utils ( internalError, minInt, maxInt ) +import Helium.StaticAnalysis.Miscellaneous.TypeConversion +import Helium.CodeGeneration.DerivingShow + +import qualified Data.Map as M + +import Helium.ModuleSystem.ImportEnvironment +import Helium.Parser.OperatorTable +import Data.Char ( isUpper ) + +import Control.Monad.Identity (Identity) +import qualified Control.Monad.Identity + +-- filter undefined errors that are caused by the removal of a duplicate definition +filterRemovedNames :: [(Name,Entity)] -> Error -> Bool +filterRemovedNames list err = + case err of + Undefined entity name _ _ -> (name,entity) `notElem` list + _ -> True + +filterDerivedNames :: [Range] -> Error -> Bool +filterDerivedNames ranges err = + case err of + Duplicated Definition names -> any (`notElem` ranges) (map getNameRange names) + _ -> True + + +uniqueKeys :: Ord key => [(key,a)] -> ([(key,a)],[[key]]) +uniqueKeys = let comp (x,_) (y,_) = compare x y + eq (x,_) (y,_) = x == y + predicate xs = length xs == 1 + in (\(xs, ys) -> (map head xs, map (map fst) ys)) + . partition predicate + . groupBy eq + . sortBy comp + + +type ScopeInfo = ( [Names] -- duplicated variables + , [Name] -- unused variables + , [(Name, Name)] -- shadowed variables + ) + +changeOfScope :: Names -> Names -> Names -> (Names, Names, ScopeInfo) +changeOfScope names unboundNames namesInScope = + let (uniqueNames, duplicatedNames) = uniqueAppearance names + unusedNames = uniqueNames \\ unboundNames + shadowedNames = let f n = [ (n, n') | n' <- namesInScope, n == n' ] + in concatMap f uniqueNames + in ( uniqueNames ++ map head duplicatedNames ++ (namesInScope \\ names) + , unboundNames \\ names + , (duplicatedNames, unusedNames, shadowedNames) + ) + +uniqueAppearance :: Ord a => [a] -> ([a],[[a]]) +uniqueAppearance = Prelude.foldr myInsert ([],[]) . group . sort + where myInsert [x] (as,bs) = (x:as,bs) + myInsert xs (as,bs) = (as,xs:bs) + +nextUnique :: Num a => a -> (a, a) +nextUnique n = (n+1, n) + + +checkType :: M.Map Name Int -> Names -> Type -> [Error] +checkType theTypeConstructors namesInScope t = + let (f, xs) = walkSpine t + xsErrors = concatMap (checkType theTypeConstructors namesInScope) xs + in + xsErrors + ++ + case f of + Type_Constructor r c -> + checkKind c theTypeConstructors (length xs) namesInScope + ++ [ TupleTooBig r + | let nameAsString = show c + , isTupleConstructor nameAsString + , length nameAsString - 1 > 10 + ] + Type_Variable _ v -> + if length xs /= 0 then + [ TypeVarApplication v ] + else + [] + _ -> + internalError "StaticAnalysis" "checkType" "unexpected type" + +walkSpine :: Type -> (Type, [Type]) +walkSpine t = + case t of + Type_Variable _ _ -> (t, []) + Type_Constructor _ _ -> (t, []) + Type_Application _ _ f xs -> + let (t', ys) = walkSpine f + in (t', ys ++ xs) + Type_Parenthesized _ t' -> walkSpine t' + Type_Qualified _ _ t' -> walkSpine t' + _ -> internalError "StaticAnalysis" "walkSpine" "unexpected type" + +checkKind :: Name -> M.Map Name Int -> Int -> Names -> [Error] +checkKind tycon@(Name_Special _ _ ('(':commas)) _ useArity _ = -- !!!Name + if expected == useArity then + [] + else + [ ArityMismatch TypeConstructor tycon expected useArity] + where + expected = + case length (takeWhile (== ',') commas) of + 0 -> 0 -- () + n -> n + 1 -- (,) (,,) ... + +checkKind tycon theTypeConstructors useArity namesInScope = + case M.lookup tycon theTypeConstructors of + Nothing -> + let hint = [ "Constructor "++show (show tycon)++" cannot be used in a type" + | tycon `elem` namesInScope + ] + in [ Undefined TypeConstructor tycon (M.keys theTypeConstructors) hint ] + Just defArity -> + if useArity /= defArity then + [ ArityMismatch TypeConstructor tycon defArity useArity ] + else + [ ] + + +findSimilarFunctionBindings :: [(Name, TpScheme)] -> [(Name,Name)] -> [Warning] +findSimilarFunctionBindings environment candidates = + let namesWithTypeDef = map fst environment + in [ uncurry SimilarFunctionBindings pair + | (n1,n2) <- candidates + , let bool1 = n1 `elem` namesWithTypeDef + bool2 = n2 `elem` namesWithTypeDef + pair = if bool1 then (n2,n1) else (n1,n2) + , bool1 `xor` bool2 + ] + +xor :: Bool -> Bool -> Bool +xor b1 b2 = not (b1 == b2) + + +simplifyContext :: OrderedTypeSynonyms -> Range -> [(Int, Name)] -> TpScheme -> Warnings +simplifyContext synonyms range intMap typescheme = + let predicates = qualifiers (unquantify typescheme) + reduced = f predicates [] + where f [] as = reverse as -- reverse to original order + f (p:ps) as + | entail synonyms standardClasses (ps++as) p = f ps as + | otherwise = f ps (p:as) + sub = listToSubstitution [ (i, TCon (show n)) | (i, n) <- intMap ] + in if length reduced == length predicates + then [] + else [ ReduceContext range (sub |-> predicates) (sub |-> reduced) ] + + +mode :: Ord a => [a] -> Maybe a -- Just ... IF any of the elements is more common +mode xs = + case filter ((== maxFreq) . snd) fs of + [(x, _)] -> Just x + _ -> Nothing + where + maxFreq = maximum (map snd fs) + fs = frequencies xs + +frequencies :: Ord a => [a] -> [(a, Int)] +frequencies = map (\ys -> (head ys, length ys)) . group . sort + + +patternConstructorErrors :: Maybe TpScheme -> Name -> Names -> Int -> Bool -> Names -> [Error] +patternConstructorErrors maybetparity name env useArity lhsPattern namesTyconEnv = + case maybetparity of + Nothing -> + [ undefinedConstructorInPat lhsPattern name env namesTyconEnv ] + Just tpScheme -> + let arity = arityOfTpScheme tpScheme + in if arity /= useArity + then [ ArityMismatch Constructor name arity useArity ] + else [] + + +simplePattern :: Pattern -> Bool +simplePattern pattern = + case pattern of + Pattern_Constructor _ name _ -> case show name of + x:_ -> isUpper x + _ -> False + _ -> False + + +-- Type signature but no function definition +-- Duplicated type signatures +-- Overloaded type scheme for a restricted pattern +checkTypeSignatures :: Names -> Names -> [(Name,TpScheme)] -> Errors +checkTypeSignatures declVarNames restrictedNames xs = + let (unique, doubles) = uniqueAppearance (map fst xs) + in [ Duplicated TypeSignature names + | names <- doubles + ] + ++ [ NoFunDef TypeSignature name declVarNames + | name <- unique + , name `notElem` declVarNames + ] + ++ [ OverloadedRestrPat name + | (name, scheme) <- xs + , name `elem` unique + , name `elem` restrictedNames + , isOverloaded scheme + ] + + +isSimplePattern :: Pattern -> Bool +isSimplePattern pattern = + case pattern of + Pattern_Variable _ _ -> True + Pattern_Parenthesized _ p -> isSimplePattern p + _ -> False + + + +checkExport :: Entity -> Name -> [Name] -> [Error] +checkExport entity name inScope = + makeUndefined entity + (if name `elem` inScope then + [] + else + [name] + ) + (nubBy equalName inScope) + +equalName :: Name -> Name -> Bool +equalName x y = + getNameName x == getNameName y + + +topLevelScopeInfo :: ScopeInfo -> ScopeInfo +topLevelScopeInfo (xs, _, _) = (xs, [], []) + +makeErrors :: [(ScopeInfo, Entity)] -> Errors +makeErrors xs = [ Duplicated entity ys | ((yss, _, _), entity) <- xs, ys <- yss ] + +makeWarnings :: [(ScopeInfo, Entity)] -> Warnings +makeWarnings xs = [ Unused entity name | ((_, names, _), entity) <- xs, name <- names ] + ++ [ Shadow n2 n1 | ((_, _, pairs), _) <- xs, (n1, n2) <- pairs ] +-- Alternative ------------------------------------------------- +-- wrapper +data Inh_Alternative = Inh_Alternative { allTypeConstructors_Inh_Alternative :: (Names), allValueConstructors_Inh_Alternative :: (Names), classEnvironment_Inh_Alternative :: (ClassEnvironment), collectScopeInfos_Inh_Alternative :: ([(ScopeInfo, Entity)]), counter_Inh_Alternative :: (Int), kindErrors_Inh_Alternative :: ([Error]), miscerrors_Inh_Alternative :: ([Error]), namesInScope_Inh_Alternative :: (Names), options_Inh_Alternative :: ([Option]), orderedTypeSynonyms_Inh_Alternative :: (OrderedTypeSynonyms), typeConstructors_Inh_Alternative :: (M.Map Name Int), valueConstructors_Inh_Alternative :: (M.Map Name TpScheme), warnings_Inh_Alternative :: ([Warning]) } +data Syn_Alternative = Syn_Alternative { collectInstances_Syn_Alternative :: ([(Name, Instance)]), collectScopeInfos_Syn_Alternative :: ([(ScopeInfo, Entity)]), counter_Syn_Alternative :: (Int), kindErrors_Syn_Alternative :: ([Error]), miscerrors_Syn_Alternative :: ([Error]), self_Syn_Alternative :: (Alternative), unboundNames_Syn_Alternative :: (Names), warnings_Syn_Alternative :: ([Warning]) } +{-# INLINABLE wrap_Alternative #-} +wrap_Alternative :: T_Alternative -> Inh_Alternative -> (Syn_Alternative ) +wrap_Alternative (T_Alternative act) (Inh_Alternative _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternative_vIn1 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_Alternative_vOut1 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_Alternative_s2 sem arg) + return (Syn_Alternative _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Alternative #-} +sem_Alternative :: Alternative -> T_Alternative +sem_Alternative ( Alternative_Hole range_ id_ ) = sem_Alternative_Hole ( sem_Range range_ ) id_ +sem_Alternative ( Alternative_Feedback range_ feedback_ alternative_ ) = sem_Alternative_Feedback ( sem_Range range_ ) feedback_ ( sem_Alternative alternative_ ) +sem_Alternative ( Alternative_Alternative range_ pattern_ righthandside_ ) = sem_Alternative_Alternative ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Alternative ( Alternative_Empty range_ ) = sem_Alternative_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Alternative = T_Alternative { + attach_T_Alternative :: Identity (T_Alternative_s2 ) + } +newtype T_Alternative_s2 = C_Alternative_s2 { + inv_Alternative_s2 :: (T_Alternative_v1 ) + } +data T_Alternative_s3 = C_Alternative_s3 +type T_Alternative_v1 = (T_Alternative_vIn1 ) -> (T_Alternative_vOut1 ) +data T_Alternative_vIn1 = T_Alternative_vIn1 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_Alternative_vOut1 = T_Alternative_vOut1 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Alternative) (Names) ([Warning]) +{-# NOINLINE sem_Alternative_Hole #-} +sem_Alternative_Hole :: T_Range -> (Integer) -> T_Alternative +sem_Alternative_Hole arg_range_ arg_id_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule0 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1 () + _self = rule2 _rangeIself arg_id_ + _lhsOself :: Alternative + _lhsOself = rule3 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule4 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule5 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule6 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule7 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule8 _lhsIwarnings + __result_ = T_Alternative_vOut1 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule0 #-} + rule0 = \ (_ :: ()) -> + [] + {-# INLINE rule1 #-} + rule1 = \ (_ :: ()) -> + [] + {-# INLINE rule2 #-} + rule2 = \ ((_rangeIself) :: Range) id_ -> + Alternative_Hole _rangeIself id_ + {-# INLINE rule3 #-} + rule3 = \ _self -> + _self + {-# INLINE rule4 #-} + rule4 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule5 #-} + rule5 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule6 #-} + rule6 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule7 #-} + rule7 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule8 #-} + rule8 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Alternative_Feedback #-} +sem_Alternative_Feedback :: T_Range -> (String) -> T_Alternative -> T_Alternative +sem_Alternative_Feedback arg_range_ arg_feedback_ arg_alternative_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _alternativeX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_alternative_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Alternative_vOut1 _alternativeIcollectInstances _alternativeIcollectScopeInfos _alternativeIcounter _alternativeIkindErrors _alternativeImiscerrors _alternativeIself _alternativeIunboundNames _alternativeIwarnings) = inv_Alternative_s2 _alternativeX2 (T_Alternative_vIn1 _alternativeOallTypeConstructors _alternativeOallValueConstructors _alternativeOclassEnvironment _alternativeOcollectScopeInfos _alternativeOcounter _alternativeOkindErrors _alternativeOmiscerrors _alternativeOnamesInScope _alternativeOoptions _alternativeOorderedTypeSynonyms _alternativeOtypeConstructors _alternativeOvalueConstructors _alternativeOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule9 _alternativeIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule10 _alternativeIunboundNames + _self = rule11 _alternativeIself _rangeIself arg_feedback_ + _lhsOself :: Alternative + _lhsOself = rule12 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule13 _alternativeIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule14 _alternativeIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule15 _alternativeIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule16 _alternativeImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule17 _alternativeIwarnings + _alternativeOallTypeConstructors = rule18 _lhsIallTypeConstructors + _alternativeOallValueConstructors = rule19 _lhsIallValueConstructors + _alternativeOclassEnvironment = rule20 _lhsIclassEnvironment + _alternativeOcollectScopeInfos = rule21 _lhsIcollectScopeInfos + _alternativeOcounter = rule22 _lhsIcounter + _alternativeOkindErrors = rule23 _lhsIkindErrors + _alternativeOmiscerrors = rule24 _lhsImiscerrors + _alternativeOnamesInScope = rule25 _lhsInamesInScope + _alternativeOoptions = rule26 _lhsIoptions + _alternativeOorderedTypeSynonyms = rule27 _lhsIorderedTypeSynonyms + _alternativeOtypeConstructors = rule28 _lhsItypeConstructors + _alternativeOvalueConstructors = rule29 _lhsIvalueConstructors + _alternativeOwarnings = rule30 _lhsIwarnings + __result_ = T_Alternative_vOut1 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule9 #-} + rule9 = \ ((_alternativeIcollectInstances) :: [(Name, Instance)]) -> + _alternativeIcollectInstances + {-# INLINE rule10 #-} + rule10 = \ ((_alternativeIunboundNames) :: Names) -> + _alternativeIunboundNames + {-# INLINE rule11 #-} + rule11 = \ ((_alternativeIself) :: Alternative) ((_rangeIself) :: Range) feedback_ -> + Alternative_Feedback _rangeIself feedback_ _alternativeIself + {-# INLINE rule12 #-} + rule12 = \ _self -> + _self + {-# INLINE rule13 #-} + rule13 = \ ((_alternativeIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _alternativeIcollectScopeInfos + {-# INLINE rule14 #-} + rule14 = \ ((_alternativeIcounter) :: Int) -> + _alternativeIcounter + {-# INLINE rule15 #-} + rule15 = \ ((_alternativeIkindErrors) :: [Error]) -> + _alternativeIkindErrors + {-# INLINE rule16 #-} + rule16 = \ ((_alternativeImiscerrors) :: [Error]) -> + _alternativeImiscerrors + {-# INLINE rule17 #-} + rule17 = \ ((_alternativeIwarnings) :: [Warning]) -> + _alternativeIwarnings + {-# INLINE rule18 #-} + rule18 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule19 #-} + rule19 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule20 #-} + rule20 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule21 #-} + rule21 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule22 #-} + rule22 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule23 #-} + rule23 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule24 #-} + rule24 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule25 #-} + rule25 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule26 #-} + rule26 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule27 #-} + rule27 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule28 #-} + rule28 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule29 #-} + rule29 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule30 #-} + rule30 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Alternative_Alternative #-} +sem_Alternative_Alternative :: T_Range -> T_Pattern -> T_RightHandSide -> T_Alternative +sem_Alternative_Alternative arg_range_ arg_pattern_ arg_righthandside_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIcollectScopeInfos _patternIcounter _patternImiscerrors _patternIpatVarNames _patternIself _patternIunboundNames _patternIwarnings) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOallTypeConstructors _patternOallValueConstructors _patternOcollectScopeInfos _patternOcounter _patternOlhsPattern _patternOmiscerrors _patternOnamesInScope _patternOtypeConstructors _patternOvalueConstructors _patternOwarnings) + (T_RightHandSide_vOut148 _righthandsideIcollectInstances _righthandsideIcollectScopeInfos _righthandsideIcounter _righthandsideIkindErrors _righthandsideImiscerrors _righthandsideIself _righthandsideIunboundNames _righthandsideIwarnings) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOallTypeConstructors _righthandsideOallValueConstructors _righthandsideOclassEnvironment _righthandsideOcollectScopeInfos _righthandsideOcounter _righthandsideOkindErrors _righthandsideOmiscerrors _righthandsideOnamesInScope _righthandsideOoptions _righthandsideOorderedTypeSynonyms _righthandsideOtypeConstructors _righthandsideOvalueConstructors _righthandsideOwarnings) + (_namesInScope,_unboundNames,_scopeInfo) = rule31 _lhsInamesInScope _patternIpatVarNames _righthandsideIunboundNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule32 _unboundNames + _patternOlhsPattern = rule33 () + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule34 _righthandsideIcollectScopeInfos _scopeInfo + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule35 _righthandsideIcollectInstances + _self = rule36 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Alternative + _lhsOself = rule37 _self + _lhsOcounter :: Int + _lhsOcounter = rule38 _righthandsideIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule39 _righthandsideIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule40 _righthandsideImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule41 _righthandsideIwarnings + _patternOallTypeConstructors = rule42 _lhsIallTypeConstructors + _patternOallValueConstructors = rule43 _lhsIallValueConstructors + _patternOcollectScopeInfos = rule44 _lhsIcollectScopeInfos + _patternOcounter = rule45 _lhsIcounter + _patternOmiscerrors = rule46 _lhsImiscerrors + _patternOnamesInScope = rule47 _namesInScope + _patternOtypeConstructors = rule48 _lhsItypeConstructors + _patternOvalueConstructors = rule49 _lhsIvalueConstructors + _patternOwarnings = rule50 _lhsIwarnings + _righthandsideOallTypeConstructors = rule51 _lhsIallTypeConstructors + _righthandsideOallValueConstructors = rule52 _lhsIallValueConstructors + _righthandsideOclassEnvironment = rule53 _lhsIclassEnvironment + _righthandsideOcollectScopeInfos = rule54 _patternIcollectScopeInfos + _righthandsideOcounter = rule55 _patternIcounter + _righthandsideOkindErrors = rule56 _lhsIkindErrors + _righthandsideOmiscerrors = rule57 _patternImiscerrors + _righthandsideOnamesInScope = rule58 _namesInScope + _righthandsideOoptions = rule59 _lhsIoptions + _righthandsideOorderedTypeSynonyms = rule60 _lhsIorderedTypeSynonyms + _righthandsideOtypeConstructors = rule61 _lhsItypeConstructors + _righthandsideOvalueConstructors = rule62 _lhsIvalueConstructors + _righthandsideOwarnings = rule63 _patternIwarnings + __result_ = T_Alternative_vOut1 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule31 #-} + rule31 = \ ((_lhsInamesInScope) :: Names) ((_patternIpatVarNames) :: Names) ((_righthandsideIunboundNames) :: Names) -> + changeOfScope _patternIpatVarNames _righthandsideIunboundNames _lhsInamesInScope + {-# INLINE rule32 #-} + rule32 = \ _unboundNames -> + _unboundNames + {-# INLINE rule33 #-} + rule33 = \ (_ :: ()) -> + False + {-# INLINE rule34 #-} + rule34 = \ ((_righthandsideIcollectScopeInfos) :: [(ScopeInfo, Entity)]) _scopeInfo -> + (_scopeInfo, Variable) : _righthandsideIcollectScopeInfos + {-# INLINE rule35 #-} + rule35 = \ ((_righthandsideIcollectInstances) :: [(Name, Instance)]) -> + _righthandsideIcollectInstances + {-# INLINE rule36 #-} + rule36 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Alternative_Alternative _rangeIself _patternIself _righthandsideIself + {-# INLINE rule37 #-} + rule37 = \ _self -> + _self + {-# INLINE rule38 #-} + rule38 = \ ((_righthandsideIcounter) :: Int) -> + _righthandsideIcounter + {-# INLINE rule39 #-} + rule39 = \ ((_righthandsideIkindErrors) :: [Error]) -> + _righthandsideIkindErrors + {-# INLINE rule40 #-} + rule40 = \ ((_righthandsideImiscerrors) :: [Error]) -> + _righthandsideImiscerrors + {-# INLINE rule41 #-} + rule41 = \ ((_righthandsideIwarnings) :: [Warning]) -> + _righthandsideIwarnings + {-# INLINE rule42 #-} + rule42 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule43 #-} + rule43 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule44 #-} + rule44 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule45 #-} + rule45 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule46 #-} + rule46 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule47 #-} + rule47 = \ _namesInScope -> + _namesInScope + {-# INLINE rule48 #-} + rule48 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule49 #-} + rule49 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule50 #-} + rule50 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule51 #-} + rule51 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule52 #-} + rule52 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule53 #-} + rule53 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule54 #-} + rule54 = \ ((_patternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternIcollectScopeInfos + {-# INLINE rule55 #-} + rule55 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule56 #-} + rule56 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule57 #-} + rule57 = \ ((_patternImiscerrors) :: [Error]) -> + _patternImiscerrors + {-# INLINE rule58 #-} + rule58 = \ _namesInScope -> + _namesInScope + {-# INLINE rule59 #-} + rule59 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule60 #-} + rule60 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule61 #-} + rule61 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule62 #-} + rule62 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule63 #-} + rule63 = \ ((_patternIwarnings) :: [Warning]) -> + _patternIwarnings +{-# NOINLINE sem_Alternative_Empty #-} +sem_Alternative_Empty :: T_Range -> T_Alternative +sem_Alternative_Empty arg_range_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule64 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule65 () + _self = rule66 _rangeIself + _lhsOself :: Alternative + _lhsOself = rule67 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule68 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule69 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule70 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule71 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule72 _lhsIwarnings + __result_ = T_Alternative_vOut1 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule64 #-} + rule64 = \ (_ :: ()) -> + [] + {-# INLINE rule65 #-} + rule65 = \ (_ :: ()) -> + [] + {-# INLINE rule66 #-} + rule66 = \ ((_rangeIself) :: Range) -> + Alternative_Empty _rangeIself + {-# INLINE rule67 #-} + rule67 = \ _self -> + _self + {-# INLINE rule68 #-} + rule68 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule69 #-} + rule69 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule70 #-} + rule70 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule71 #-} + rule71 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule72 #-} + rule72 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Alternatives ------------------------------------------------ +-- wrapper +data Inh_Alternatives = Inh_Alternatives { allTypeConstructors_Inh_Alternatives :: (Names), allValueConstructors_Inh_Alternatives :: (Names), classEnvironment_Inh_Alternatives :: (ClassEnvironment), collectScopeInfos_Inh_Alternatives :: ([(ScopeInfo, Entity)]), counter_Inh_Alternatives :: (Int), kindErrors_Inh_Alternatives :: ([Error]), miscerrors_Inh_Alternatives :: ([Error]), namesInScope_Inh_Alternatives :: (Names), options_Inh_Alternatives :: ([Option]), orderedTypeSynonyms_Inh_Alternatives :: (OrderedTypeSynonyms), typeConstructors_Inh_Alternatives :: (M.Map Name Int), valueConstructors_Inh_Alternatives :: (M.Map Name TpScheme), warnings_Inh_Alternatives :: ([Warning]) } +data Syn_Alternatives = Syn_Alternatives { collectInstances_Syn_Alternatives :: ([(Name, Instance)]), collectScopeInfos_Syn_Alternatives :: ([(ScopeInfo, Entity)]), counter_Syn_Alternatives :: (Int), kindErrors_Syn_Alternatives :: ([Error]), miscerrors_Syn_Alternatives :: ([Error]), self_Syn_Alternatives :: (Alternatives), unboundNames_Syn_Alternatives :: (Names), warnings_Syn_Alternatives :: ([Warning]) } +{-# INLINABLE wrap_Alternatives #-} +wrap_Alternatives :: T_Alternatives -> Inh_Alternatives -> (Syn_Alternatives ) +wrap_Alternatives (T_Alternatives act) (Inh_Alternatives _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternatives_vIn4 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_Alternatives_vOut4 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_Alternatives_s5 sem arg) + return (Syn_Alternatives _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Alternatives #-} +sem_Alternatives :: Alternatives -> T_Alternatives +sem_Alternatives list = Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) + +-- semantic domain +newtype T_Alternatives = T_Alternatives { + attach_T_Alternatives :: Identity (T_Alternatives_s5 ) + } +newtype T_Alternatives_s5 = C_Alternatives_s5 { + inv_Alternatives_s5 :: (T_Alternatives_v4 ) + } +data T_Alternatives_s6 = C_Alternatives_s6 +type T_Alternatives_v4 = (T_Alternatives_vIn4 ) -> (T_Alternatives_vOut4 ) +data T_Alternatives_vIn4 = T_Alternatives_vIn4 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_Alternatives_vOut4 = T_Alternatives_vOut4 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Alternatives) (Names) ([Warning]) +{-# NOINLINE sem_Alternatives_Cons #-} +sem_Alternatives_Cons :: T_Alternative -> T_Alternatives -> T_Alternatives +sem_Alternatives_Cons arg_hd_ arg_tl_ = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_hd_)) + _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_tl_)) + (T_Alternative_vOut1 _hdIcollectInstances _hdIcollectScopeInfos _hdIcounter _hdIkindErrors _hdImiscerrors _hdIself _hdIunboundNames _hdIwarnings) = inv_Alternative_s2 _hdX2 (T_Alternative_vIn1 _hdOallTypeConstructors _hdOallValueConstructors _hdOclassEnvironment _hdOcollectScopeInfos _hdOcounter _hdOkindErrors _hdOmiscerrors _hdOnamesInScope _hdOoptions _hdOorderedTypeSynonyms _hdOtypeConstructors _hdOvalueConstructors _hdOwarnings) + (T_Alternatives_vOut4 _tlIcollectInstances _tlIcollectScopeInfos _tlIcounter _tlIkindErrors _tlImiscerrors _tlIself _tlIunboundNames _tlIwarnings) = inv_Alternatives_s5 _tlX5 (T_Alternatives_vIn4 _tlOallTypeConstructors _tlOallValueConstructors _tlOclassEnvironment _tlOcollectScopeInfos _tlOcounter _tlOkindErrors _tlOmiscerrors _tlOnamesInScope _tlOoptions _tlOorderedTypeSynonyms _tlOtypeConstructors _tlOvalueConstructors _tlOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule73 _hdIcollectInstances _tlIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule74 _hdIunboundNames _tlIunboundNames + _self = rule75 _hdIself _tlIself + _lhsOself :: Alternatives + _lhsOself = rule76 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule77 _tlIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule78 _tlIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule79 _tlIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule80 _tlImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule81 _tlIwarnings + _hdOallTypeConstructors = rule82 _lhsIallTypeConstructors + _hdOallValueConstructors = rule83 _lhsIallValueConstructors + _hdOclassEnvironment = rule84 _lhsIclassEnvironment + _hdOcollectScopeInfos = rule85 _lhsIcollectScopeInfos + _hdOcounter = rule86 _lhsIcounter + _hdOkindErrors = rule87 _lhsIkindErrors + _hdOmiscerrors = rule88 _lhsImiscerrors + _hdOnamesInScope = rule89 _lhsInamesInScope + _hdOoptions = rule90 _lhsIoptions + _hdOorderedTypeSynonyms = rule91 _lhsIorderedTypeSynonyms + _hdOtypeConstructors = rule92 _lhsItypeConstructors + _hdOvalueConstructors = rule93 _lhsIvalueConstructors + _hdOwarnings = rule94 _lhsIwarnings + _tlOallTypeConstructors = rule95 _lhsIallTypeConstructors + _tlOallValueConstructors = rule96 _lhsIallValueConstructors + _tlOclassEnvironment = rule97 _lhsIclassEnvironment + _tlOcollectScopeInfos = rule98 _hdIcollectScopeInfos + _tlOcounter = rule99 _hdIcounter + _tlOkindErrors = rule100 _hdIkindErrors + _tlOmiscerrors = rule101 _hdImiscerrors + _tlOnamesInScope = rule102 _lhsInamesInScope + _tlOoptions = rule103 _lhsIoptions + _tlOorderedTypeSynonyms = rule104 _lhsIorderedTypeSynonyms + _tlOtypeConstructors = rule105 _lhsItypeConstructors + _tlOvalueConstructors = rule106 _lhsIvalueConstructors + _tlOwarnings = rule107 _hdIwarnings + __result_ = T_Alternatives_vOut4 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule73 #-} + rule73 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule74 #-} + rule74 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule75 #-} + rule75 = \ ((_hdIself) :: Alternative) ((_tlIself) :: Alternatives) -> + (:) _hdIself _tlIself + {-# INLINE rule76 #-} + rule76 = \ _self -> + _self + {-# INLINE rule77 #-} + rule77 = \ ((_tlIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _tlIcollectScopeInfos + {-# INLINE rule78 #-} + rule78 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule79 #-} + rule79 = \ ((_tlIkindErrors) :: [Error]) -> + _tlIkindErrors + {-# INLINE rule80 #-} + rule80 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule81 #-} + rule81 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule82 #-} + rule82 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule83 #-} + rule83 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule84 #-} + rule84 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule85 #-} + rule85 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule86 #-} + rule86 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule87 #-} + rule87 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule88 #-} + rule88 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule89 #-} + rule89 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule90 #-} + rule90 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule91 #-} + rule91 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule92 #-} + rule92 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule93 #-} + rule93 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule94 #-} + rule94 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule95 #-} + rule95 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule96 #-} + rule96 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule97 #-} + rule97 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule98 #-} + rule98 = \ ((_hdIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _hdIcollectScopeInfos + {-# INLINE rule99 #-} + rule99 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule100 #-} + rule100 = \ ((_hdIkindErrors) :: [Error]) -> + _hdIkindErrors + {-# INLINE rule101 #-} + rule101 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule102 #-} + rule102 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule103 #-} + rule103 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule104 #-} + rule104 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule105 #-} + rule105 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule106 #-} + rule106 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule107 #-} + rule107 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_Alternatives_Nil #-} +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule108 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule109 () + _self = rule110 () + _lhsOself :: Alternatives + _lhsOself = rule111 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule112 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule113 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule114 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule115 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule116 _lhsIwarnings + __result_ = T_Alternatives_vOut4 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule108 #-} + rule108 = \ (_ :: ()) -> + [] + {-# INLINE rule109 #-} + rule109 = \ (_ :: ()) -> + [] + {-# INLINE rule110 #-} + rule110 = \ (_ :: ()) -> + [] + {-# INLINE rule111 #-} + rule111 = \ _self -> + _self + {-# INLINE rule112 #-} + rule112 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule113 #-} + rule113 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule114 #-} + rule114 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule115 #-} + rule115 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule116 #-} + rule116 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- AnnotatedType ----------------------------------------------- +-- wrapper +data Inh_AnnotatedType = Inh_AnnotatedType { allTypeConstructors_Inh_AnnotatedType :: (Names), allValueConstructors_Inh_AnnotatedType :: (Names), counter_Inh_AnnotatedType :: (Int), kindErrors_Inh_AnnotatedType :: ([Error]), miscerrors_Inh_AnnotatedType :: ([Error]), namesInScope_Inh_AnnotatedType :: (Names), options_Inh_AnnotatedType :: ([Option]), typeConstructors_Inh_AnnotatedType :: (M.Map Name Int), valueConstructors_Inh_AnnotatedType :: (M.Map Name TpScheme), warnings_Inh_AnnotatedType :: ([Warning]) } +data Syn_AnnotatedType = Syn_AnnotatedType { counter_Syn_AnnotatedType :: (Int), kindErrors_Syn_AnnotatedType :: ([Error]), miscerrors_Syn_AnnotatedType :: ([Error]), self_Syn_AnnotatedType :: (AnnotatedType), type_Syn_AnnotatedType :: (Type), typevariables_Syn_AnnotatedType :: (Names), unboundNames_Syn_AnnotatedType :: (Names), warnings_Syn_AnnotatedType :: ([Warning]) } +{-# INLINABLE wrap_AnnotatedType #-} +wrap_AnnotatedType :: T_AnnotatedType -> Inh_AnnotatedType -> (Syn_AnnotatedType ) +wrap_AnnotatedType (T_AnnotatedType act) (Inh_AnnotatedType _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedType_vIn7 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_AnnotatedType_vOut7 _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOtype _lhsOtypevariables _lhsOunboundNames _lhsOwarnings) <- return (inv_AnnotatedType_s8 sem arg) + return (Syn_AnnotatedType _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOtype _lhsOtypevariables _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# INLINE sem_AnnotatedType #-} +sem_AnnotatedType :: AnnotatedType -> T_AnnotatedType +sem_AnnotatedType ( AnnotatedType_AnnotatedType range_ strict_ type_ ) = sem_AnnotatedType_AnnotatedType ( sem_Range range_ ) strict_ ( sem_Type type_ ) + +-- semantic domain +newtype T_AnnotatedType = T_AnnotatedType { + attach_T_AnnotatedType :: Identity (T_AnnotatedType_s8 ) + } +newtype T_AnnotatedType_s8 = C_AnnotatedType_s8 { + inv_AnnotatedType_s8 :: (T_AnnotatedType_v7 ) + } +data T_AnnotatedType_s9 = C_AnnotatedType_s9 +type T_AnnotatedType_v7 = (T_AnnotatedType_vIn7 ) -> (T_AnnotatedType_vOut7 ) +data T_AnnotatedType_vIn7 = T_AnnotatedType_vIn7 (Names) (Names) (Int) ([Error]) ([Error]) (Names) ([Option]) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_AnnotatedType_vOut7 = T_AnnotatedType_vOut7 (Int) ([Error]) ([Error]) (AnnotatedType) (Type) (Names) (Names) ([Warning]) +{-# NOINLINE sem_AnnotatedType_AnnotatedType #-} +sem_AnnotatedType_AnnotatedType :: T_Range -> (Bool) -> T_Type -> T_AnnotatedType +sem_AnnotatedType_AnnotatedType arg_range_ arg_strict_ arg_type_ = T_AnnotatedType (return st8) where + {-# NOINLINE st8 #-} + st8 = let + v7 :: T_AnnotatedType_v7 + v7 = \ (T_AnnotatedType_vIn7 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIcontextRange _typeImiscerrors _typeIself _typeItypevariables _typeIwarnings) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOallTypeConstructors _typeOmiscerrors _typeOoptions _typeOtypeConstructors _typeOwarnings) + _lhsOtype :: Type + _lhsOtype = rule117 _typeIself + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule118 _lhsIkindErrors _newErrors + _newErrors = rule119 _lhsIallValueConstructors _lhsInamesInScope _lhsItypeConstructors _typeIself + _lhsOtypevariables :: Names + _lhsOtypevariables = rule120 _typeItypevariables + _lhsOunboundNames :: Names + _lhsOunboundNames = rule121 () + _self = rule122 _rangeIself _typeIself arg_strict_ + _lhsOself :: AnnotatedType + _lhsOself = rule123 _self + _lhsOcounter :: Int + _lhsOcounter = rule124 _lhsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule125 _typeImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule126 _typeIwarnings + _typeOallTypeConstructors = rule127 _lhsIallTypeConstructors + _typeOmiscerrors = rule128 _lhsImiscerrors + _typeOoptions = rule129 _lhsIoptions + _typeOtypeConstructors = rule130 _lhsItypeConstructors + _typeOwarnings = rule131 _lhsIwarnings + __result_ = T_AnnotatedType_vOut7 _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOtype _lhsOtypevariables _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_AnnotatedType_s8 v7 + {-# INLINE rule117 #-} + rule117 = \ ((_typeIself) :: Type) -> + _typeIself + {-# INLINE rule118 #-} + rule118 = \ ((_lhsIkindErrors) :: [Error]) _newErrors -> + _newErrors ++ _lhsIkindErrors + {-# INLINE rule119 #-} + rule119 = \ ((_lhsIallValueConstructors) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsItypeConstructors) :: M.Map Name Int) ((_typeIself) :: Type) -> + checkType _lhsItypeConstructors (_lhsInamesInScope ++ _lhsIallValueConstructors) _typeIself + {-# INLINE rule120 #-} + rule120 = \ ((_typeItypevariables) :: Names) -> + _typeItypevariables + {-# INLINE rule121 #-} + rule121 = \ (_ :: ()) -> + [] + {-# INLINE rule122 #-} + rule122 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) strict_ -> + AnnotatedType_AnnotatedType _rangeIself strict_ _typeIself + {-# INLINE rule123 #-} + rule123 = \ _self -> + _self + {-# INLINE rule124 #-} + rule124 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule125 #-} + rule125 = \ ((_typeImiscerrors) :: [Error]) -> + _typeImiscerrors + {-# INLINE rule126 #-} + rule126 = \ ((_typeIwarnings) :: [Warning]) -> + _typeIwarnings + {-# INLINE rule127 #-} + rule127 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule128 #-} + rule128 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule129 #-} + rule129 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule130 #-} + rule130 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule131 #-} + rule131 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- AnnotatedTypes ---------------------------------------------- +-- wrapper +data Inh_AnnotatedTypes = Inh_AnnotatedTypes { allTypeConstructors_Inh_AnnotatedTypes :: (Names), allValueConstructors_Inh_AnnotatedTypes :: (Names), counter_Inh_AnnotatedTypes :: (Int), kindErrors_Inh_AnnotatedTypes :: ([Error]), miscerrors_Inh_AnnotatedTypes :: ([Error]), namesInScope_Inh_AnnotatedTypes :: (Names), options_Inh_AnnotatedTypes :: ([Option]), typeConstructors_Inh_AnnotatedTypes :: (M.Map Name Int), valueConstructors_Inh_AnnotatedTypes :: (M.Map Name TpScheme), warnings_Inh_AnnotatedTypes :: ([Warning]) } +data Syn_AnnotatedTypes = Syn_AnnotatedTypes { counter_Syn_AnnotatedTypes :: (Int), kindErrors_Syn_AnnotatedTypes :: ([Error]), miscerrors_Syn_AnnotatedTypes :: ([Error]), self_Syn_AnnotatedTypes :: (AnnotatedTypes), types_Syn_AnnotatedTypes :: (Types), typevariables_Syn_AnnotatedTypes :: (Names), unboundNames_Syn_AnnotatedTypes :: (Names), warnings_Syn_AnnotatedTypes :: ([Warning]) } +{-# INLINABLE wrap_AnnotatedTypes #-} +wrap_AnnotatedTypes :: T_AnnotatedTypes -> Inh_AnnotatedTypes -> (Syn_AnnotatedTypes ) +wrap_AnnotatedTypes (T_AnnotatedTypes act) (Inh_AnnotatedTypes _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedTypes_vIn10 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_AnnotatedTypes_vOut10 _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOtypes _lhsOtypevariables _lhsOunboundNames _lhsOwarnings) <- return (inv_AnnotatedTypes_s11 sem arg) + return (Syn_AnnotatedTypes _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOtypes _lhsOtypevariables _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_AnnotatedTypes #-} +sem_AnnotatedTypes :: AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes list = Prelude.foldr sem_AnnotatedTypes_Cons sem_AnnotatedTypes_Nil (Prelude.map sem_AnnotatedType list) + +-- semantic domain +newtype T_AnnotatedTypes = T_AnnotatedTypes { + attach_T_AnnotatedTypes :: Identity (T_AnnotatedTypes_s11 ) + } +newtype T_AnnotatedTypes_s11 = C_AnnotatedTypes_s11 { + inv_AnnotatedTypes_s11 :: (T_AnnotatedTypes_v10 ) + } +data T_AnnotatedTypes_s12 = C_AnnotatedTypes_s12 +type T_AnnotatedTypes_v10 = (T_AnnotatedTypes_vIn10 ) -> (T_AnnotatedTypes_vOut10 ) +data T_AnnotatedTypes_vIn10 = T_AnnotatedTypes_vIn10 (Names) (Names) (Int) ([Error]) ([Error]) (Names) ([Option]) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_AnnotatedTypes_vOut10 = T_AnnotatedTypes_vOut10 (Int) ([Error]) ([Error]) (AnnotatedTypes) (Types) (Names) (Names) ([Warning]) +{-# NOINLINE sem_AnnotatedTypes_Cons #-} +sem_AnnotatedTypes_Cons :: T_AnnotatedType -> T_AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes_Cons arg_hd_ arg_tl_ = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _hdX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_hd_)) + _tlX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_tl_)) + (T_AnnotatedType_vOut7 _hdIcounter _hdIkindErrors _hdImiscerrors _hdIself _hdItype _hdItypevariables _hdIunboundNames _hdIwarnings) = inv_AnnotatedType_s8 _hdX8 (T_AnnotatedType_vIn7 _hdOallTypeConstructors _hdOallValueConstructors _hdOcounter _hdOkindErrors _hdOmiscerrors _hdOnamesInScope _hdOoptions _hdOtypeConstructors _hdOvalueConstructors _hdOwarnings) + (T_AnnotatedTypes_vOut10 _tlIcounter _tlIkindErrors _tlImiscerrors _tlIself _tlItypes _tlItypevariables _tlIunboundNames _tlIwarnings) = inv_AnnotatedTypes_s11 _tlX11 (T_AnnotatedTypes_vIn10 _tlOallTypeConstructors _tlOallValueConstructors _tlOcounter _tlOkindErrors _tlOmiscerrors _tlOnamesInScope _tlOoptions _tlOtypeConstructors _tlOvalueConstructors _tlOwarnings) + _lhsOtypes :: Types + _lhsOtypes = rule132 _hdItype _tlItypes + _lhsOtypevariables :: Names + _lhsOtypevariables = rule133 _hdItypevariables _tlItypevariables + _lhsOunboundNames :: Names + _lhsOunboundNames = rule134 _hdIunboundNames _tlIunboundNames + _self = rule135 _hdIself _tlIself + _lhsOself :: AnnotatedTypes + _lhsOself = rule136 _self + _lhsOcounter :: Int + _lhsOcounter = rule137 _tlIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule138 _tlIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule139 _tlImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule140 _tlIwarnings + _hdOallTypeConstructors = rule141 _lhsIallTypeConstructors + _hdOallValueConstructors = rule142 _lhsIallValueConstructors + _hdOcounter = rule143 _lhsIcounter + _hdOkindErrors = rule144 _lhsIkindErrors + _hdOmiscerrors = rule145 _lhsImiscerrors + _hdOnamesInScope = rule146 _lhsInamesInScope + _hdOoptions = rule147 _lhsIoptions + _hdOtypeConstructors = rule148 _lhsItypeConstructors + _hdOvalueConstructors = rule149 _lhsIvalueConstructors + _hdOwarnings = rule150 _lhsIwarnings + _tlOallTypeConstructors = rule151 _lhsIallTypeConstructors + _tlOallValueConstructors = rule152 _lhsIallValueConstructors + _tlOcounter = rule153 _hdIcounter + _tlOkindErrors = rule154 _hdIkindErrors + _tlOmiscerrors = rule155 _hdImiscerrors + _tlOnamesInScope = rule156 _lhsInamesInScope + _tlOoptions = rule157 _lhsIoptions + _tlOtypeConstructors = rule158 _lhsItypeConstructors + _tlOvalueConstructors = rule159 _lhsIvalueConstructors + _tlOwarnings = rule160 _hdIwarnings + __result_ = T_AnnotatedTypes_vOut10 _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOtypes _lhsOtypevariables _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule132 #-} + rule132 = \ ((_hdItype) :: Type) ((_tlItypes) :: Types) -> + _hdItype : _tlItypes + {-# INLINE rule133 #-} + rule133 = \ ((_hdItypevariables) :: Names) ((_tlItypevariables) :: Names) -> + _hdItypevariables ++ _tlItypevariables + {-# INLINE rule134 #-} + rule134 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule135 #-} + rule135 = \ ((_hdIself) :: AnnotatedType) ((_tlIself) :: AnnotatedTypes) -> + (:) _hdIself _tlIself + {-# INLINE rule136 #-} + rule136 = \ _self -> + _self + {-# INLINE rule137 #-} + rule137 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule138 #-} + rule138 = \ ((_tlIkindErrors) :: [Error]) -> + _tlIkindErrors + {-# INLINE rule139 #-} + rule139 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule140 #-} + rule140 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule141 #-} + rule141 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule142 #-} + rule142 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule143 #-} + rule143 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule144 #-} + rule144 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule145 #-} + rule145 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule146 #-} + rule146 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule147 #-} + rule147 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule148 #-} + rule148 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule149 #-} + rule149 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule150 #-} + rule150 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule151 #-} + rule151 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule152 #-} + rule152 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule153 #-} + rule153 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule154 #-} + rule154 = \ ((_hdIkindErrors) :: [Error]) -> + _hdIkindErrors + {-# INLINE rule155 #-} + rule155 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule156 #-} + rule156 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule157 #-} + rule157 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule158 #-} + rule158 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule159 #-} + rule159 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule160 #-} + rule160 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_AnnotatedTypes_Nil #-} +sem_AnnotatedTypes_Nil :: T_AnnotatedTypes +sem_AnnotatedTypes_Nil = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOtypes :: Types + _lhsOtypes = rule161 () + _lhsOtypevariables :: Names + _lhsOtypevariables = rule162 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule163 () + _self = rule164 () + _lhsOself :: AnnotatedTypes + _lhsOself = rule165 _self + _lhsOcounter :: Int + _lhsOcounter = rule166 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule167 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule168 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule169 _lhsIwarnings + __result_ = T_AnnotatedTypes_vOut10 _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOtypes _lhsOtypevariables _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule161 #-} + rule161 = \ (_ :: ()) -> + [] + {-# INLINE rule162 #-} + rule162 = \ (_ :: ()) -> + [] + {-# INLINE rule163 #-} + rule163 = \ (_ :: ()) -> + [] + {-# INLINE rule164 #-} + rule164 = \ (_ :: ()) -> + [] + {-# INLINE rule165 #-} + rule165 = \ _self -> + _self + {-# INLINE rule166 #-} + rule166 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule167 #-} + rule167 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule168 #-} + rule168 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule169 #-} + rule169 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Body -------------------------------------------------------- +-- wrapper +data Inh_Body = Inh_Body { allTypeConstructors_Inh_Body :: (Names), allValueConstructors_Inh_Body :: (Names), classEnvironment_Inh_Body :: (ClassEnvironment), collectScopeInfos_Inh_Body :: ([(ScopeInfo, Entity)]), collectTypeConstructors_Inh_Body :: ([(Name,Int)]), collectTypeSynonyms_Inh_Body :: ([(Name,(Int,Tps -> Tp))]), collectValueConstructors_Inh_Body :: ([(Name,TpScheme)]), counter_Inh_Body :: (Int), kindErrors_Inh_Body :: ([Error]), miscerrors_Inh_Body :: ([Error]), namesInScope_Inh_Body :: (Names), operatorFixities_Inh_Body :: ([(Name,(Int,Assoc))]), options_Inh_Body :: ([Option]), orderedTypeSynonyms_Inh_Body :: (OrderedTypeSynonyms), typeConstructors_Inh_Body :: (M.Map Name Int), valueConstructors_Inh_Body :: (M.Map Name TpScheme), warnings_Inh_Body :: ([Warning]) } +data Syn_Body = Syn_Body { collectInstances_Syn_Body :: ([(Name, Instance)]), collectScopeInfos_Syn_Body :: ([(ScopeInfo, Entity)]), collectTypeConstructors_Syn_Body :: ([(Name,Int)]), collectTypeSynonyms_Syn_Body :: ([(Name,(Int,Tps -> Tp))]), collectValueConstructors_Syn_Body :: ([(Name,TpScheme)]), counter_Syn_Body :: (Int), declVarNames_Syn_Body :: (Names), importedModules_Syn_Body :: (Names), kindErrors_Syn_Body :: ([Error]), miscerrors_Syn_Body :: ([Error]), operatorFixities_Syn_Body :: ([(Name,(Int,Assoc))]), self_Syn_Body :: (Body), typeSignatures_Syn_Body :: ([(Name,TpScheme)]), unboundNames_Syn_Body :: (Names), warnings_Syn_Body :: ([Warning]) } +{-# INLINABLE wrap_Body #-} +wrap_Body :: T_Body -> Inh_Body -> (Syn_Body ) +wrap_Body (T_Body act) (Inh_Body _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Body_vIn13 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_Body_vOut13 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOimportedModules _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOself _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings) <- return (inv_Body_s14 sem arg) + return (Syn_Body _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOimportedModules _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOself _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Body #-} +sem_Body :: Body -> T_Body +sem_Body ( Body_Hole range_ id_ ) = sem_Body_Hole ( sem_Range range_ ) id_ +sem_Body ( Body_Body range_ importdeclarations_ declarations_ ) = sem_Body_Body ( sem_Range range_ ) ( sem_ImportDeclarations importdeclarations_ ) ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_Body = T_Body { + attach_T_Body :: Identity (T_Body_s14 ) + } +newtype T_Body_s14 = C_Body_s14 { + inv_Body_s14 :: (T_Body_v13 ) + } +data T_Body_s15 = C_Body_s15 +type T_Body_v13 = (T_Body_vIn13 ) -> (T_Body_vOut13 ) +data T_Body_vIn13 = T_Body_vIn13 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) ([(Name,Int)]) ([(Name,(Int,Tps -> Tp))]) ([(Name,TpScheme)]) (Int) ([Error]) ([Error]) (Names) ([(Name,(Int,Assoc))]) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_Body_vOut13 = T_Body_vOut13 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) ([(Name,Int)]) ([(Name,(Int,Tps -> Tp))]) ([(Name,TpScheme)]) (Int) (Names) (Names) ([Error]) ([Error]) ([(Name,(Int,Assoc))]) (Body) ([(Name,TpScheme)]) (Names) ([Warning]) +{-# NOINLINE sem_Body_Hole #-} +sem_Body_Hole :: T_Range -> (Integer) -> T_Body +sem_Body_Hole arg_range_ arg_id_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule170 () + _lhsOimportedModules :: Names + _lhsOimportedModules = rule171 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule172 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule173 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule174 () + _self = rule175 _rangeIself arg_id_ + _lhsOself :: Body + _lhsOself = rule176 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule177 _lhsIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule178 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule179 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule180 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule181 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule182 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule183 _lhsImiscerrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule184 _lhsIoperatorFixities + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule185 _lhsIwarnings + __result_ = T_Body_vOut13 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOimportedModules _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOself _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule170 #-} + rule170 = \ (_ :: ()) -> + [] + {-# INLINE rule171 #-} + rule171 = \ (_ :: ()) -> + [] + {-# INLINE rule172 #-} + rule172 = \ (_ :: ()) -> + [] + {-# INLINE rule173 #-} + rule173 = \ (_ :: ()) -> + [] + {-# INLINE rule174 #-} + rule174 = \ (_ :: ()) -> + [] + {-# INLINE rule175 #-} + rule175 = \ ((_rangeIself) :: Range) id_ -> + Body_Hole _rangeIself id_ + {-# INLINE rule176 #-} + rule176 = \ _self -> + _self + {-# INLINE rule177 #-} + rule177 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule178 #-} + rule178 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule179 #-} + rule179 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule180 #-} + rule180 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule181 #-} + rule181 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule182 #-} + rule182 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule183 #-} + rule183 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule184 #-} + rule184 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule185 #-} + rule185 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Body_Body #-} +sem_Body_Body :: T_Range -> T_ImportDeclarations -> T_Declarations -> T_Body +sem_Body_Body arg_range_ arg_importdeclarations_ arg_declarations_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importdeclarationsX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_importdeclarations_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ImportDeclarations_vOut73 _importdeclarationsIimportedModules _importdeclarationsIself) = inv_ImportDeclarations_s74 _importdeclarationsX74 (T_ImportDeclarations_vIn73 _importdeclarationsOimportedModules) + (T_Declarations_vOut31 _declarationsIcollectInstances _declarationsIcollectScopeInfos _declarationsIcollectTypeConstructors _declarationsIcollectTypeSynonyms _declarationsIcollectValueConstructors _declarationsIcounter _declarationsIdeclVarNames _declarationsIkindErrors _declarationsImiscerrors _declarationsIoperatorFixities _declarationsIpreviousWasAlsoFB _declarationsIrestrictedNames _declarationsIself _declarationsIsuspiciousFBs _declarationsItypeSignatures _declarationsIunboundNames _declarationsIwarnings) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOallTypeConstructors _declarationsOallValueConstructors _declarationsOclassEnvironment _declarationsOcollectScopeInfos _declarationsOcollectTypeConstructors _declarationsOcollectTypeSynonyms _declarationsOcollectValueConstructors _declarationsOcounter _declarationsOkindErrors _declarationsOmiscerrors _declarationsOnamesInScope _declarationsOoperatorFixities _declarationsOoptions _declarationsOorderedTypeSynonyms _declarationsOpreviousWasAlsoFB _declarationsOsuspiciousFBs _declarationsOtypeConstructors _declarationsOtypeSignatures _declarationsOvalueConstructors _declarationsOwarnings) + _declarationsOtypeSignatures = rule186 () + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule187 _declarationsIwarnings _suspiciousErrors + _declarationsOpreviousWasAlsoFB = rule188 () + _declarationsOsuspiciousFBs = rule189 () + _suspiciousErrors = rule190 _declarationsIsuspiciousFBs _declarationsItypeSignatures + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule191 _declarationsImiscerrors _typeSignatureErrors + _typeSignatureErrors = rule192 _declarationsIdeclVarNames _declarationsIrestrictedNames _declarationsItypeSignatures + _importdeclarationsOimportedModules = rule193 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule194 _declarationsIcollectInstances + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule195 _declarationsIdeclVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule196 _declarationsIunboundNames + _self = rule197 _declarationsIself _importdeclarationsIself _rangeIself + _lhsOself :: Body + _lhsOself = rule198 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule199 _declarationsIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule200 _declarationsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule201 _declarationsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule202 _declarationsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule203 _declarationsIcounter + _lhsOimportedModules :: Names + _lhsOimportedModules = rule204 _importdeclarationsIimportedModules + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule205 _declarationsIkindErrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule206 _declarationsIoperatorFixities + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule207 _declarationsItypeSignatures + _declarationsOallTypeConstructors = rule208 _lhsIallTypeConstructors + _declarationsOallValueConstructors = rule209 _lhsIallValueConstructors + _declarationsOclassEnvironment = rule210 _lhsIclassEnvironment + _declarationsOcollectScopeInfos = rule211 _lhsIcollectScopeInfos + _declarationsOcollectTypeConstructors = rule212 _lhsIcollectTypeConstructors + _declarationsOcollectTypeSynonyms = rule213 _lhsIcollectTypeSynonyms + _declarationsOcollectValueConstructors = rule214 _lhsIcollectValueConstructors + _declarationsOcounter = rule215 _lhsIcounter + _declarationsOkindErrors = rule216 _lhsIkindErrors + _declarationsOmiscerrors = rule217 _lhsImiscerrors + _declarationsOnamesInScope = rule218 _lhsInamesInScope + _declarationsOoperatorFixities = rule219 _lhsIoperatorFixities + _declarationsOoptions = rule220 _lhsIoptions + _declarationsOorderedTypeSynonyms = rule221 _lhsIorderedTypeSynonyms + _declarationsOtypeConstructors = rule222 _lhsItypeConstructors + _declarationsOvalueConstructors = rule223 _lhsIvalueConstructors + _declarationsOwarnings = rule224 _lhsIwarnings + __result_ = T_Body_vOut13 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOimportedModules _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOself _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule186 #-} + rule186 = \ (_ :: ()) -> + [] + {-# INLINE rule187 #-} + rule187 = \ ((_declarationsIwarnings) :: [Warning]) _suspiciousErrors -> + _declarationsIwarnings ++ + _suspiciousErrors + {-# INLINE rule188 #-} + rule188 = \ (_ :: ()) -> + Nothing + {-# INLINE rule189 #-} + rule189 = \ (_ :: ()) -> + [] + {-# INLINE rule190 #-} + rule190 = \ ((_declarationsIsuspiciousFBs) :: [(Name,Name)]) ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + findSimilarFunctionBindings _declarationsItypeSignatures _declarationsIsuspiciousFBs + {-# INLINE rule191 #-} + rule191 = \ ((_declarationsImiscerrors) :: [Error]) _typeSignatureErrors -> + _typeSignatureErrors ++ _declarationsImiscerrors + {-# INLINE rule192 #-} + rule192 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIrestrictedNames) :: Names) ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + checkTypeSignatures _declarationsIdeclVarNames _declarationsIrestrictedNames _declarationsItypeSignatures + {-# INLINE rule193 #-} + rule193 = \ (_ :: ()) -> + [] + {-# INLINE rule194 #-} + rule194 = \ ((_declarationsIcollectInstances) :: [(Name, Instance)]) -> + _declarationsIcollectInstances + {-# INLINE rule195 #-} + rule195 = \ ((_declarationsIdeclVarNames) :: Names) -> + _declarationsIdeclVarNames + {-# INLINE rule196 #-} + rule196 = \ ((_declarationsIunboundNames) :: Names) -> + _declarationsIunboundNames + {-# INLINE rule197 #-} + rule197 = \ ((_declarationsIself) :: Declarations) ((_importdeclarationsIself) :: ImportDeclarations) ((_rangeIself) :: Range) -> + Body_Body _rangeIself _importdeclarationsIself _declarationsIself + {-# INLINE rule198 #-} + rule198 = \ _self -> + _self + {-# INLINE rule199 #-} + rule199 = \ ((_declarationsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _declarationsIcollectScopeInfos + {-# INLINE rule200 #-} + rule200 = \ ((_declarationsIcollectTypeConstructors) :: [(Name,Int)]) -> + _declarationsIcollectTypeConstructors + {-# INLINE rule201 #-} + rule201 = \ ((_declarationsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _declarationsIcollectTypeSynonyms + {-# INLINE rule202 #-} + rule202 = \ ((_declarationsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _declarationsIcollectValueConstructors + {-# INLINE rule203 #-} + rule203 = \ ((_declarationsIcounter) :: Int) -> + _declarationsIcounter + {-# INLINE rule204 #-} + rule204 = \ ((_importdeclarationsIimportedModules) :: Names) -> + _importdeclarationsIimportedModules + {-# INLINE rule205 #-} + rule205 = \ ((_declarationsIkindErrors) :: [Error]) -> + _declarationsIkindErrors + {-# INLINE rule206 #-} + rule206 = \ ((_declarationsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _declarationsIoperatorFixities + {-# INLINE rule207 #-} + rule207 = \ ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + _declarationsItypeSignatures + {-# INLINE rule208 #-} + rule208 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule209 #-} + rule209 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule210 #-} + rule210 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule211 #-} + rule211 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule212 #-} + rule212 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule213 #-} + rule213 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule214 #-} + rule214 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule215 #-} + rule215 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule216 #-} + rule216 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule217 #-} + rule217 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule218 #-} + rule218 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule219 #-} + rule219 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule220 #-} + rule220 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule221 #-} + rule221 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule222 #-} + rule222 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule223 #-} + rule223 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule224 #-} + rule224 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Constructor ------------------------------------------------- +-- wrapper +data Inh_Constructor = Inh_Constructor { allTypeConstructors_Inh_Constructor :: (Names), allValueConstructors_Inh_Constructor :: (Names), collectValueConstructors_Inh_Constructor :: ([(Name,TpScheme)]), counter_Inh_Constructor :: (Int), kindErrors_Inh_Constructor :: ([Error]), miscerrors_Inh_Constructor :: ([Error]), namesInScope_Inh_Constructor :: (Names), options_Inh_Constructor :: ([Option]), simpletype_Inh_Constructor :: (SimpleType), typeConstructors_Inh_Constructor :: (M.Map Name Int), valueConstructors_Inh_Constructor :: (M.Map Name TpScheme), warnings_Inh_Constructor :: ([Warning]) } +data Syn_Constructor = Syn_Constructor { collectValueConstructors_Syn_Constructor :: ([(Name,TpScheme)]), counter_Syn_Constructor :: (Int), kindErrors_Syn_Constructor :: ([Error]), miscerrors_Syn_Constructor :: ([Error]), parameterTypes_Syn_Constructor :: (Tps), self_Syn_Constructor :: (Constructor), typevariables_Syn_Constructor :: (Names), unboundNames_Syn_Constructor :: (Names), warnings_Syn_Constructor :: ([Warning]) } +{-# INLINABLE wrap_Constructor #-} +wrap_Constructor :: T_Constructor -> Inh_Constructor -> (Syn_Constructor ) +wrap_Constructor (T_Constructor act) (Inh_Constructor _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIsimpletype _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructor_vIn16 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIsimpletype _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_Constructor_vOut16 _lhsOcollectValueConstructors _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOparameterTypes _lhsOself _lhsOtypevariables _lhsOunboundNames _lhsOwarnings) <- return (inv_Constructor_s17 sem arg) + return (Syn_Constructor _lhsOcollectValueConstructors _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOparameterTypes _lhsOself _lhsOtypevariables _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Constructor #-} +sem_Constructor :: Constructor -> T_Constructor +sem_Constructor ( Constructor_Constructor range_ constructor_ types_ ) = sem_Constructor_Constructor ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_AnnotatedTypes types_ ) +sem_Constructor ( Constructor_Infix range_ leftType_ constructorOperator_ rightType_ ) = sem_Constructor_Infix ( sem_Range range_ ) ( sem_AnnotatedType leftType_ ) ( sem_Name constructorOperator_ ) ( sem_AnnotatedType rightType_ ) +sem_Constructor ( Constructor_Record range_ constructor_ fieldDeclarations_ ) = sem_Constructor_Record ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_FieldDeclarations fieldDeclarations_ ) + +-- semantic domain +newtype T_Constructor = T_Constructor { + attach_T_Constructor :: Identity (T_Constructor_s17 ) + } +newtype T_Constructor_s17 = C_Constructor_s17 { + inv_Constructor_s17 :: (T_Constructor_v16 ) + } +data T_Constructor_s18 = C_Constructor_s18 +type T_Constructor_v16 = (T_Constructor_vIn16 ) -> (T_Constructor_vOut16 ) +data T_Constructor_vIn16 = T_Constructor_vIn16 (Names) (Names) ([(Name,TpScheme)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (SimpleType) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_Constructor_vOut16 = T_Constructor_vOut16 ([(Name,TpScheme)]) (Int) ([Error]) ([Error]) (Tps) (Constructor) (Names) (Names) ([Warning]) +{-# NOINLINE sem_Constructor_Constructor #-} +sem_Constructor_Constructor :: T_Range -> T_Name -> T_AnnotatedTypes -> T_Constructor +sem_Constructor_Constructor arg_range_ arg_constructor_ arg_types_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIsimpletype _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _typesX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_AnnotatedTypes_vOut10 _typesIcounter _typesIkindErrors _typesImiscerrors _typesIself _typesItypes _typesItypevariables _typesIunboundNames _typesIwarnings) = inv_AnnotatedTypes_s11 _typesX11 (T_AnnotatedTypes_vIn10 _typesOallTypeConstructors _typesOallValueConstructors _typesOcounter _typesOkindErrors _typesOmiscerrors _typesOnamesInScope _typesOoptions _typesOtypeConstructors _typesOvalueConstructors _typesOwarnings) + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule225 _constructorIself _lhsIcollectValueConstructors _typeScheme + _lhsOparameterTypes :: Tps + _lhsOparameterTypes = rule226 _tps + _typeScheme = rule227 _tp _tps + (_tp,_tps) = rule228 _lhsIsimpletype _typesItypes + _lhsOtypevariables :: Names + _lhsOtypevariables = rule229 _typesItypevariables + _lhsOunboundNames :: Names + _lhsOunboundNames = rule230 _typesIunboundNames + _self = rule231 _constructorIself _rangeIself _typesIself + _lhsOself :: Constructor + _lhsOself = rule232 _self + _lhsOcounter :: Int + _lhsOcounter = rule233 _typesIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule234 _typesIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule235 _typesImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule236 _typesIwarnings + _typesOallTypeConstructors = rule237 _lhsIallTypeConstructors + _typesOallValueConstructors = rule238 _lhsIallValueConstructors + _typesOcounter = rule239 _lhsIcounter + _typesOkindErrors = rule240 _lhsIkindErrors + _typesOmiscerrors = rule241 _lhsImiscerrors + _typesOnamesInScope = rule242 _lhsInamesInScope + _typesOoptions = rule243 _lhsIoptions + _typesOtypeConstructors = rule244 _lhsItypeConstructors + _typesOvalueConstructors = rule245 _lhsIvalueConstructors + _typesOwarnings = rule246 _lhsIwarnings + __result_ = T_Constructor_vOut16 _lhsOcollectValueConstructors _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOparameterTypes _lhsOself _lhsOtypevariables _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule225 #-} + rule225 = \ ((_constructorIself) :: Name) ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) _typeScheme -> + (_constructorIself, _typeScheme) : _lhsIcollectValueConstructors + {-# INLINE rule226 #-} + rule226 = \ _tps -> + _tps + {-# INLINE rule227 #-} + rule227 = \ _tp _tps -> + generalizeAll ([] .=>. foldr (.->.) _tp _tps) + {-# INLINE rule228 #-} + rule228 = \ ((_lhsIsimpletype) :: SimpleType) ((_typesItypes) :: Types) -> + convertFromSimpleTypeAndTypes _lhsIsimpletype _typesItypes + {-# INLINE rule229 #-} + rule229 = \ ((_typesItypevariables) :: Names) -> + _typesItypevariables + {-# INLINE rule230 #-} + rule230 = \ ((_typesIunboundNames) :: Names) -> + _typesIunboundNames + {-# INLINE rule231 #-} + rule231 = \ ((_constructorIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: AnnotatedTypes) -> + Constructor_Constructor _rangeIself _constructorIself _typesIself + {-# INLINE rule232 #-} + rule232 = \ _self -> + _self + {-# INLINE rule233 #-} + rule233 = \ ((_typesIcounter) :: Int) -> + _typesIcounter + {-# INLINE rule234 #-} + rule234 = \ ((_typesIkindErrors) :: [Error]) -> + _typesIkindErrors + {-# INLINE rule235 #-} + rule235 = \ ((_typesImiscerrors) :: [Error]) -> + _typesImiscerrors + {-# INLINE rule236 #-} + rule236 = \ ((_typesIwarnings) :: [Warning]) -> + _typesIwarnings + {-# INLINE rule237 #-} + rule237 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule238 #-} + rule238 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule239 #-} + rule239 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule240 #-} + rule240 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule241 #-} + rule241 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule242 #-} + rule242 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule243 #-} + rule243 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule244 #-} + rule244 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule245 #-} + rule245 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule246 #-} + rule246 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Constructor_Infix #-} +sem_Constructor_Infix :: T_Range -> T_AnnotatedType -> T_Name -> T_AnnotatedType -> T_Constructor +sem_Constructor_Infix arg_range_ arg_leftType_ arg_constructorOperator_ arg_rightType_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIsimpletype _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_leftType_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_rightType_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_AnnotatedType_vOut7 _leftTypeIcounter _leftTypeIkindErrors _leftTypeImiscerrors _leftTypeIself _leftTypeItype _leftTypeItypevariables _leftTypeIunboundNames _leftTypeIwarnings) = inv_AnnotatedType_s8 _leftTypeX8 (T_AnnotatedType_vIn7 _leftTypeOallTypeConstructors _leftTypeOallValueConstructors _leftTypeOcounter _leftTypeOkindErrors _leftTypeOmiscerrors _leftTypeOnamesInScope _leftTypeOoptions _leftTypeOtypeConstructors _leftTypeOvalueConstructors _leftTypeOwarnings) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_AnnotatedType_vOut7 _rightTypeIcounter _rightTypeIkindErrors _rightTypeImiscerrors _rightTypeIself _rightTypeItype _rightTypeItypevariables _rightTypeIunboundNames _rightTypeIwarnings) = inv_AnnotatedType_s8 _rightTypeX8 (T_AnnotatedType_vIn7 _rightTypeOallTypeConstructors _rightTypeOallValueConstructors _rightTypeOcounter _rightTypeOkindErrors _rightTypeOmiscerrors _rightTypeOnamesInScope _rightTypeOoptions _rightTypeOtypeConstructors _rightTypeOvalueConstructors _rightTypeOwarnings) + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule247 _constructorOperatorIself _lhsIcollectValueConstructors _typeScheme + _lhsOparameterTypes :: Tps + _lhsOparameterTypes = rule248 _tps + _typeScheme = rule249 _tp _tps + (_tp,_tps) = rule250 _leftTypeItype _lhsIsimpletype _rightTypeItype + _lhsOtypevariables :: Names + _lhsOtypevariables = rule251 _leftTypeItypevariables _rightTypeItypevariables + _lhsOunboundNames :: Names + _lhsOunboundNames = rule252 _leftTypeIunboundNames _rightTypeIunboundNames + _self = rule253 _constructorOperatorIself _leftTypeIself _rangeIself _rightTypeIself + _lhsOself :: Constructor + _lhsOself = rule254 _self + _lhsOcounter :: Int + _lhsOcounter = rule255 _rightTypeIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule256 _rightTypeIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule257 _rightTypeImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule258 _rightTypeIwarnings + _leftTypeOallTypeConstructors = rule259 _lhsIallTypeConstructors + _leftTypeOallValueConstructors = rule260 _lhsIallValueConstructors + _leftTypeOcounter = rule261 _lhsIcounter + _leftTypeOkindErrors = rule262 _lhsIkindErrors + _leftTypeOmiscerrors = rule263 _lhsImiscerrors + _leftTypeOnamesInScope = rule264 _lhsInamesInScope + _leftTypeOoptions = rule265 _lhsIoptions + _leftTypeOtypeConstructors = rule266 _lhsItypeConstructors + _leftTypeOvalueConstructors = rule267 _lhsIvalueConstructors + _leftTypeOwarnings = rule268 _lhsIwarnings + _rightTypeOallTypeConstructors = rule269 _lhsIallTypeConstructors + _rightTypeOallValueConstructors = rule270 _lhsIallValueConstructors + _rightTypeOcounter = rule271 _leftTypeIcounter + _rightTypeOkindErrors = rule272 _leftTypeIkindErrors + _rightTypeOmiscerrors = rule273 _leftTypeImiscerrors + _rightTypeOnamesInScope = rule274 _lhsInamesInScope + _rightTypeOoptions = rule275 _lhsIoptions + _rightTypeOtypeConstructors = rule276 _lhsItypeConstructors + _rightTypeOvalueConstructors = rule277 _lhsIvalueConstructors + _rightTypeOwarnings = rule278 _leftTypeIwarnings + __result_ = T_Constructor_vOut16 _lhsOcollectValueConstructors _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOparameterTypes _lhsOself _lhsOtypevariables _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule247 #-} + rule247 = \ ((_constructorOperatorIself) :: Name) ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) _typeScheme -> + (_constructorOperatorIself, _typeScheme) : _lhsIcollectValueConstructors + {-# INLINE rule248 #-} + rule248 = \ _tps -> + _tps + {-# INLINE rule249 #-} + rule249 = \ _tp _tps -> + generalizeAll ([] .=>. foldr (.->.) _tp _tps) + {-# INLINE rule250 #-} + rule250 = \ ((_leftTypeItype) :: Type) ((_lhsIsimpletype) :: SimpleType) ((_rightTypeItype) :: Type) -> + convertFromSimpleTypeAndTypes _lhsIsimpletype [_leftTypeItype,_rightTypeItype] + {-# INLINE rule251 #-} + rule251 = \ ((_leftTypeItypevariables) :: Names) ((_rightTypeItypevariables) :: Names) -> + _leftTypeItypevariables ++ _rightTypeItypevariables + {-# INLINE rule252 #-} + rule252 = \ ((_leftTypeIunboundNames) :: Names) ((_rightTypeIunboundNames) :: Names) -> + _leftTypeIunboundNames ++ _rightTypeIunboundNames + {-# INLINE rule253 #-} + rule253 = \ ((_constructorOperatorIself) :: Name) ((_leftTypeIself) :: AnnotatedType) ((_rangeIself) :: Range) ((_rightTypeIself) :: AnnotatedType) -> + Constructor_Infix _rangeIself _leftTypeIself _constructorOperatorIself _rightTypeIself + {-# INLINE rule254 #-} + rule254 = \ _self -> + _self + {-# INLINE rule255 #-} + rule255 = \ ((_rightTypeIcounter) :: Int) -> + _rightTypeIcounter + {-# INLINE rule256 #-} + rule256 = \ ((_rightTypeIkindErrors) :: [Error]) -> + _rightTypeIkindErrors + {-# INLINE rule257 #-} + rule257 = \ ((_rightTypeImiscerrors) :: [Error]) -> + _rightTypeImiscerrors + {-# INLINE rule258 #-} + rule258 = \ ((_rightTypeIwarnings) :: [Warning]) -> + _rightTypeIwarnings + {-# INLINE rule259 #-} + rule259 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule260 #-} + rule260 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule261 #-} + rule261 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule262 #-} + rule262 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule263 #-} + rule263 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule264 #-} + rule264 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule265 #-} + rule265 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule266 #-} + rule266 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule267 #-} + rule267 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule268 #-} + rule268 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule269 #-} + rule269 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule270 #-} + rule270 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule271 #-} + rule271 = \ ((_leftTypeIcounter) :: Int) -> + _leftTypeIcounter + {-# INLINE rule272 #-} + rule272 = \ ((_leftTypeIkindErrors) :: [Error]) -> + _leftTypeIkindErrors + {-# INLINE rule273 #-} + rule273 = \ ((_leftTypeImiscerrors) :: [Error]) -> + _leftTypeImiscerrors + {-# INLINE rule274 #-} + rule274 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule275 #-} + rule275 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule276 #-} + rule276 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule277 #-} + rule277 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule278 #-} + rule278 = \ ((_leftTypeIwarnings) :: [Warning]) -> + _leftTypeIwarnings +{-# NOINLINE sem_Constructor_Record #-} +sem_Constructor_Record :: T_Range -> T_Name -> T_FieldDeclarations -> T_Constructor +sem_Constructor_Record arg_range_ arg_constructor_ arg_fieldDeclarations_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIsimpletype _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _fieldDeclarationsX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_fieldDeclarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_FieldDeclarations_vOut49 _fieldDeclarationsIcounter _fieldDeclarationsImiscerrors _fieldDeclarationsIself _fieldDeclarationsIunboundNames) = inv_FieldDeclarations_s50 _fieldDeclarationsX50 (T_FieldDeclarations_vIn49 _fieldDeclarationsOcounter _fieldDeclarationsOmiscerrors _fieldDeclarationsOnamesInScope _fieldDeclarationsOoptions) + _lhsOparameterTypes :: Tps + _lhsOparameterTypes = rule279 () + _lhsOtypevariables :: Names + _lhsOtypevariables = rule280 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule281 _fieldDeclarationsIunboundNames + _self = rule282 _constructorIself _fieldDeclarationsIself _rangeIself + _lhsOself :: Constructor + _lhsOself = rule283 _self + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule284 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule285 _fieldDeclarationsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule286 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule287 _fieldDeclarationsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule288 _lhsIwarnings + _fieldDeclarationsOcounter = rule289 _lhsIcounter + _fieldDeclarationsOmiscerrors = rule290 _lhsImiscerrors + _fieldDeclarationsOnamesInScope = rule291 _lhsInamesInScope + _fieldDeclarationsOoptions = rule292 _lhsIoptions + __result_ = T_Constructor_vOut16 _lhsOcollectValueConstructors _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOparameterTypes _lhsOself _lhsOtypevariables _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule279 #-} + rule279 = \ (_ :: ()) -> + [] + {-# INLINE rule280 #-} + rule280 = \ (_ :: ()) -> + [] + {-# INLINE rule281 #-} + rule281 = \ ((_fieldDeclarationsIunboundNames) :: Names) -> + _fieldDeclarationsIunboundNames + {-# INLINE rule282 #-} + rule282 = \ ((_constructorIself) :: Name) ((_fieldDeclarationsIself) :: FieldDeclarations) ((_rangeIself) :: Range) -> + Constructor_Record _rangeIself _constructorIself _fieldDeclarationsIself + {-# INLINE rule283 #-} + rule283 = \ _self -> + _self + {-# INLINE rule284 #-} + rule284 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule285 #-} + rule285 = \ ((_fieldDeclarationsIcounter) :: Int) -> + _fieldDeclarationsIcounter + {-# INLINE rule286 #-} + rule286 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule287 #-} + rule287 = \ ((_fieldDeclarationsImiscerrors) :: [Error]) -> + _fieldDeclarationsImiscerrors + {-# INLINE rule288 #-} + rule288 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule289 #-} + rule289 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule290 #-} + rule290 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule291 #-} + rule291 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule292 #-} + rule292 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + +-- Constructors ------------------------------------------------ +-- wrapper +data Inh_Constructors = Inh_Constructors { allTypeConstructors_Inh_Constructors :: (Names), allValueConstructors_Inh_Constructors :: (Names), collectValueConstructors_Inh_Constructors :: ([(Name,TpScheme)]), counter_Inh_Constructors :: (Int), kindErrors_Inh_Constructors :: ([Error]), miscerrors_Inh_Constructors :: ([Error]), namesInScope_Inh_Constructors :: (Names), options_Inh_Constructors :: ([Option]), simpletype_Inh_Constructors :: (SimpleType), typeConstructors_Inh_Constructors :: (M.Map Name Int), valueConstructors_Inh_Constructors :: (M.Map Name TpScheme), warnings_Inh_Constructors :: ([Warning]) } +data Syn_Constructors = Syn_Constructors { collectValueConstructors_Syn_Constructors :: ([(Name,TpScheme)]), counter_Syn_Constructors :: (Int), kindErrors_Syn_Constructors :: ([Error]), miscerrors_Syn_Constructors :: ([Error]), parameterTypes_Syn_Constructors :: (Tps), self_Syn_Constructors :: (Constructors), typevariables_Syn_Constructors :: (Names), unboundNames_Syn_Constructors :: (Names), warnings_Syn_Constructors :: ([Warning]) } +{-# INLINABLE wrap_Constructors #-} +wrap_Constructors :: T_Constructors -> Inh_Constructors -> (Syn_Constructors ) +wrap_Constructors (T_Constructors act) (Inh_Constructors _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIsimpletype _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructors_vIn19 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIsimpletype _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_Constructors_vOut19 _lhsOcollectValueConstructors _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOparameterTypes _lhsOself _lhsOtypevariables _lhsOunboundNames _lhsOwarnings) <- return (inv_Constructors_s20 sem arg) + return (Syn_Constructors _lhsOcollectValueConstructors _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOparameterTypes _lhsOself _lhsOtypevariables _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Constructors #-} +sem_Constructors :: Constructors -> T_Constructors +sem_Constructors list = Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list) + +-- semantic domain +newtype T_Constructors = T_Constructors { + attach_T_Constructors :: Identity (T_Constructors_s20 ) + } +newtype T_Constructors_s20 = C_Constructors_s20 { + inv_Constructors_s20 :: (T_Constructors_v19 ) + } +data T_Constructors_s21 = C_Constructors_s21 +type T_Constructors_v19 = (T_Constructors_vIn19 ) -> (T_Constructors_vOut19 ) +data T_Constructors_vIn19 = T_Constructors_vIn19 (Names) (Names) ([(Name,TpScheme)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (SimpleType) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_Constructors_vOut19 = T_Constructors_vOut19 ([(Name,TpScheme)]) (Int) ([Error]) ([Error]) (Tps) (Constructors) (Names) (Names) ([Warning]) +{-# NOINLINE sem_Constructors_Cons #-} +sem_Constructors_Cons :: T_Constructor -> T_Constructors -> T_Constructors +sem_Constructors_Cons arg_hd_ arg_tl_ = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIsimpletype _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _hdX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_hd_)) + _tlX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_tl_)) + (T_Constructor_vOut16 _hdIcollectValueConstructors _hdIcounter _hdIkindErrors _hdImiscerrors _hdIparameterTypes _hdIself _hdItypevariables _hdIunboundNames _hdIwarnings) = inv_Constructor_s17 _hdX17 (T_Constructor_vIn16 _hdOallTypeConstructors _hdOallValueConstructors _hdOcollectValueConstructors _hdOcounter _hdOkindErrors _hdOmiscerrors _hdOnamesInScope _hdOoptions _hdOsimpletype _hdOtypeConstructors _hdOvalueConstructors _hdOwarnings) + (T_Constructors_vOut19 _tlIcollectValueConstructors _tlIcounter _tlIkindErrors _tlImiscerrors _tlIparameterTypes _tlIself _tlItypevariables _tlIunboundNames _tlIwarnings) = inv_Constructors_s20 _tlX20 (T_Constructors_vIn19 _tlOallTypeConstructors _tlOallValueConstructors _tlOcollectValueConstructors _tlOcounter _tlOkindErrors _tlOmiscerrors _tlOnamesInScope _tlOoptions _tlOsimpletype _tlOtypeConstructors _tlOvalueConstructors _tlOwarnings) + _lhsOparameterTypes :: Tps + _lhsOparameterTypes = rule293 _hdIparameterTypes _tlIparameterTypes + _lhsOtypevariables :: Names + _lhsOtypevariables = rule294 _hdItypevariables _tlItypevariables + _lhsOunboundNames :: Names + _lhsOunboundNames = rule295 _hdIunboundNames _tlIunboundNames + _self = rule296 _hdIself _tlIself + _lhsOself :: Constructors + _lhsOself = rule297 _self + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule298 _tlIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule299 _tlIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule300 _tlIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule301 _tlImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule302 _tlIwarnings + _hdOallTypeConstructors = rule303 _lhsIallTypeConstructors + _hdOallValueConstructors = rule304 _lhsIallValueConstructors + _hdOcollectValueConstructors = rule305 _lhsIcollectValueConstructors + _hdOcounter = rule306 _lhsIcounter + _hdOkindErrors = rule307 _lhsIkindErrors + _hdOmiscerrors = rule308 _lhsImiscerrors + _hdOnamesInScope = rule309 _lhsInamesInScope + _hdOoptions = rule310 _lhsIoptions + _hdOsimpletype = rule311 _lhsIsimpletype + _hdOtypeConstructors = rule312 _lhsItypeConstructors + _hdOvalueConstructors = rule313 _lhsIvalueConstructors + _hdOwarnings = rule314 _lhsIwarnings + _tlOallTypeConstructors = rule315 _lhsIallTypeConstructors + _tlOallValueConstructors = rule316 _lhsIallValueConstructors + _tlOcollectValueConstructors = rule317 _hdIcollectValueConstructors + _tlOcounter = rule318 _hdIcounter + _tlOkindErrors = rule319 _hdIkindErrors + _tlOmiscerrors = rule320 _hdImiscerrors + _tlOnamesInScope = rule321 _lhsInamesInScope + _tlOoptions = rule322 _lhsIoptions + _tlOsimpletype = rule323 _lhsIsimpletype + _tlOtypeConstructors = rule324 _lhsItypeConstructors + _tlOvalueConstructors = rule325 _lhsIvalueConstructors + _tlOwarnings = rule326 _hdIwarnings + __result_ = T_Constructors_vOut19 _lhsOcollectValueConstructors _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOparameterTypes _lhsOself _lhsOtypevariables _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule293 #-} + rule293 = \ ((_hdIparameterTypes) :: Tps) ((_tlIparameterTypes) :: Tps) -> + _hdIparameterTypes ++ _tlIparameterTypes + {-# INLINE rule294 #-} + rule294 = \ ((_hdItypevariables) :: Names) ((_tlItypevariables) :: Names) -> + _hdItypevariables ++ _tlItypevariables + {-# INLINE rule295 #-} + rule295 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule296 #-} + rule296 = \ ((_hdIself) :: Constructor) ((_tlIself) :: Constructors) -> + (:) _hdIself _tlIself + {-# INLINE rule297 #-} + rule297 = \ _self -> + _self + {-# INLINE rule298 #-} + rule298 = \ ((_tlIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _tlIcollectValueConstructors + {-# INLINE rule299 #-} + rule299 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule300 #-} + rule300 = \ ((_tlIkindErrors) :: [Error]) -> + _tlIkindErrors + {-# INLINE rule301 #-} + rule301 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule302 #-} + rule302 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule303 #-} + rule303 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule304 #-} + rule304 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule305 #-} + rule305 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule306 #-} + rule306 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule307 #-} + rule307 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule308 #-} + rule308 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule309 #-} + rule309 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule310 #-} + rule310 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule311 #-} + rule311 = \ ((_lhsIsimpletype) :: SimpleType) -> + _lhsIsimpletype + {-# INLINE rule312 #-} + rule312 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule313 #-} + rule313 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule314 #-} + rule314 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule315 #-} + rule315 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule316 #-} + rule316 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule317 #-} + rule317 = \ ((_hdIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _hdIcollectValueConstructors + {-# INLINE rule318 #-} + rule318 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule319 #-} + rule319 = \ ((_hdIkindErrors) :: [Error]) -> + _hdIkindErrors + {-# INLINE rule320 #-} + rule320 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule321 #-} + rule321 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule322 #-} + rule322 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule323 #-} + rule323 = \ ((_lhsIsimpletype) :: SimpleType) -> + _lhsIsimpletype + {-# INLINE rule324 #-} + rule324 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule325 #-} + rule325 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule326 #-} + rule326 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_Constructors_Nil #-} +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIsimpletype _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOparameterTypes :: Tps + _lhsOparameterTypes = rule327 () + _lhsOtypevariables :: Names + _lhsOtypevariables = rule328 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule329 () + _self = rule330 () + _lhsOself :: Constructors + _lhsOself = rule331 _self + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule332 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule333 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule334 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule335 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule336 _lhsIwarnings + __result_ = T_Constructors_vOut19 _lhsOcollectValueConstructors _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOparameterTypes _lhsOself _lhsOtypevariables _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule327 #-} + rule327 = \ (_ :: ()) -> + [] + {-# INLINE rule328 #-} + rule328 = \ (_ :: ()) -> + [] + {-# INLINE rule329 #-} + rule329 = \ (_ :: ()) -> + [] + {-# INLINE rule330 #-} + rule330 = \ (_ :: ()) -> + [] + {-# INLINE rule331 #-} + rule331 = \ _self -> + _self + {-# INLINE rule332 #-} + rule332 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule333 #-} + rule333 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule334 #-} + rule334 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule335 #-} + rule335 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule336 #-} + rule336 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- ContextItem ------------------------------------------------- +-- wrapper +data Inh_ContextItem = Inh_ContextItem { allTypeConstructors_Inh_ContextItem :: (Names), miscerrors_Inh_ContextItem :: ([Error]), options_Inh_ContextItem :: ([Option]), typeConstructors_Inh_ContextItem :: (M.Map Name Int), warnings_Inh_ContextItem :: ([Warning]) } +data Syn_ContextItem = Syn_ContextItem { contextRanges_Syn_ContextItem :: ([Range]), contextVars_Syn_ContextItem :: ([Name]), miscerrors_Syn_ContextItem :: ([Error]), self_Syn_ContextItem :: (ContextItem), warnings_Syn_ContextItem :: ([Warning]) } +{-# INLINABLE wrap_ContextItem #-} +wrap_ContextItem :: T_ContextItem -> Inh_ContextItem -> (Syn_ContextItem ) +wrap_ContextItem (T_ContextItem act) (Inh_ContextItem _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItem_vIn22 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings + (T_ContextItem_vOut22 _lhsOcontextRanges _lhsOcontextVars _lhsOmiscerrors _lhsOself _lhsOwarnings) <- return (inv_ContextItem_s23 sem arg) + return (Syn_ContextItem _lhsOcontextRanges _lhsOcontextVars _lhsOmiscerrors _lhsOself _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_ContextItem #-} +sem_ContextItem :: ContextItem -> T_ContextItem +sem_ContextItem ( ContextItem_ContextItem range_ name_ types_ ) = sem_ContextItem_ContextItem ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Types types_ ) + +-- semantic domain +newtype T_ContextItem = T_ContextItem { + attach_T_ContextItem :: Identity (T_ContextItem_s23 ) + } +newtype T_ContextItem_s23 = C_ContextItem_s23 { + inv_ContextItem_s23 :: (T_ContextItem_v22 ) + } +data T_ContextItem_s24 = C_ContextItem_s24 +type T_ContextItem_v22 = (T_ContextItem_vIn22 ) -> (T_ContextItem_vOut22 ) +data T_ContextItem_vIn22 = T_ContextItem_vIn22 (Names) ([Error]) ([Option]) (M.Map Name Int) ([Warning]) +data T_ContextItem_vOut22 = T_ContextItem_vOut22 ([Range]) ([Name]) ([Error]) (ContextItem) ([Warning]) +{-# NOINLINE sem_ContextItem_ContextItem #-} +sem_ContextItem_ContextItem :: T_Range -> T_Name -> T_Types -> T_ContextItem +sem_ContextItem_ContextItem arg_range_ arg_name_ arg_types_ = T_ContextItem (return st23) where + {-# NOINLINE st23 #-} + st23 = let + v22 :: T_ContextItem_v22 + v22 = \ (T_ContextItem_vIn22 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesImiscerrors _typesIself _typesItypevariables _typesIwarnings) = inv_Types_s167 _typesX167 (T_Types_vIn166 _typesOallTypeConstructors _typesOmiscerrors _typesOoptions _typesOtypeConstructors _typesOwarnings) + _lhsOcontextRanges :: [Range] + _lhsOcontextRanges = rule337 _rangeIself + _lhsOcontextVars :: [Name] + _lhsOcontextVars = rule338 _typesItypevariables + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule339 _nameIself _typesImiscerrors + _tyconEnv = rule340 () + _self = rule341 _nameIself _rangeIself _typesIself + _lhsOself :: ContextItem + _lhsOself = rule342 _self + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule343 _typesIwarnings + _typesOallTypeConstructors = rule344 _lhsIallTypeConstructors + _typesOmiscerrors = rule345 _lhsImiscerrors + _typesOoptions = rule346 _lhsIoptions + _typesOtypeConstructors = rule347 _lhsItypeConstructors + _typesOwarnings = rule348 _lhsIwarnings + __result_ = T_ContextItem_vOut22 _lhsOcontextRanges _lhsOcontextVars _lhsOmiscerrors _lhsOself _lhsOwarnings + in __result_ ) + in C_ContextItem_s23 v22 + {-# INLINE rule337 #-} + rule337 = \ ((_rangeIself) :: Range) -> + [_rangeIself] + {-# INLINE rule338 #-} + rule338 = \ ((_typesItypevariables) :: Names) -> + _typesItypevariables + {-# INLINE rule339 #-} + rule339 = \ ((_nameIself) :: Name) ((_typesImiscerrors) :: [Error]) -> + if elem (getNameName _nameIself) (M.keys standardClasses) + then _typesImiscerrors + else UnknownClass _nameIself : _typesImiscerrors + {-# INLINE rule340 #-} + rule340 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "ContextItem.ContextItem" + {-# INLINE rule341 #-} + rule341 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + ContextItem_ContextItem _rangeIself _nameIself _typesIself + {-# INLINE rule342 #-} + rule342 = \ _self -> + _self + {-# INLINE rule343 #-} + rule343 = \ ((_typesIwarnings) :: [Warning]) -> + _typesIwarnings + {-# INLINE rule344 #-} + rule344 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule345 #-} + rule345 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule346 #-} + rule346 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule347 #-} + rule347 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule348 #-} + rule348 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- ContextItems ------------------------------------------------ +-- wrapper +data Inh_ContextItems = Inh_ContextItems { allTypeConstructors_Inh_ContextItems :: (Names), miscerrors_Inh_ContextItems :: ([Error]), options_Inh_ContextItems :: ([Option]), typeConstructors_Inh_ContextItems :: (M.Map Name Int), warnings_Inh_ContextItems :: ([Warning]) } +data Syn_ContextItems = Syn_ContextItems { contextRanges_Syn_ContextItems :: ([Range]), contextVars_Syn_ContextItems :: ([Name]), miscerrors_Syn_ContextItems :: ([Error]), self_Syn_ContextItems :: (ContextItems), warnings_Syn_ContextItems :: ([Warning]) } +{-# INLINABLE wrap_ContextItems #-} +wrap_ContextItems :: T_ContextItems -> Inh_ContextItems -> (Syn_ContextItems ) +wrap_ContextItems (T_ContextItems act) (Inh_ContextItems _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItems_vIn25 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings + (T_ContextItems_vOut25 _lhsOcontextRanges _lhsOcontextVars _lhsOmiscerrors _lhsOself _lhsOwarnings) <- return (inv_ContextItems_s26 sem arg) + return (Syn_ContextItems _lhsOcontextRanges _lhsOcontextVars _lhsOmiscerrors _lhsOself _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_ContextItems #-} +sem_ContextItems :: ContextItems -> T_ContextItems +sem_ContextItems list = Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list) + +-- semantic domain +newtype T_ContextItems = T_ContextItems { + attach_T_ContextItems :: Identity (T_ContextItems_s26 ) + } +newtype T_ContextItems_s26 = C_ContextItems_s26 { + inv_ContextItems_s26 :: (T_ContextItems_v25 ) + } +data T_ContextItems_s27 = C_ContextItems_s27 +type T_ContextItems_v25 = (T_ContextItems_vIn25 ) -> (T_ContextItems_vOut25 ) +data T_ContextItems_vIn25 = T_ContextItems_vIn25 (Names) ([Error]) ([Option]) (M.Map Name Int) ([Warning]) +data T_ContextItems_vOut25 = T_ContextItems_vOut25 ([Range]) ([Name]) ([Error]) (ContextItems) ([Warning]) +{-# NOINLINE sem_ContextItems_Cons #-} +sem_ContextItems_Cons :: T_ContextItem -> T_ContextItems -> T_ContextItems +sem_ContextItems_Cons arg_hd_ arg_tl_ = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _hdX23 = Control.Monad.Identity.runIdentity (attach_T_ContextItem (arg_hd_)) + _tlX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_tl_)) + (T_ContextItem_vOut22 _hdIcontextRanges _hdIcontextVars _hdImiscerrors _hdIself _hdIwarnings) = inv_ContextItem_s23 _hdX23 (T_ContextItem_vIn22 _hdOallTypeConstructors _hdOmiscerrors _hdOoptions _hdOtypeConstructors _hdOwarnings) + (T_ContextItems_vOut25 _tlIcontextRanges _tlIcontextVars _tlImiscerrors _tlIself _tlIwarnings) = inv_ContextItems_s26 _tlX26 (T_ContextItems_vIn25 _tlOallTypeConstructors _tlOmiscerrors _tlOoptions _tlOtypeConstructors _tlOwarnings) + _lhsOcontextRanges :: [Range] + _lhsOcontextRanges = rule349 _hdIcontextRanges _tlIcontextRanges + _lhsOcontextVars :: [Name] + _lhsOcontextVars = rule350 _hdIcontextVars _tlIcontextVars + _self = rule351 _hdIself _tlIself + _lhsOself :: ContextItems + _lhsOself = rule352 _self + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule353 _tlImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule354 _tlIwarnings + _hdOallTypeConstructors = rule355 _lhsIallTypeConstructors + _hdOmiscerrors = rule356 _lhsImiscerrors + _hdOoptions = rule357 _lhsIoptions + _hdOtypeConstructors = rule358 _lhsItypeConstructors + _hdOwarnings = rule359 _lhsIwarnings + _tlOallTypeConstructors = rule360 _lhsIallTypeConstructors + _tlOmiscerrors = rule361 _hdImiscerrors + _tlOoptions = rule362 _lhsIoptions + _tlOtypeConstructors = rule363 _lhsItypeConstructors + _tlOwarnings = rule364 _hdIwarnings + __result_ = T_ContextItems_vOut25 _lhsOcontextRanges _lhsOcontextVars _lhsOmiscerrors _lhsOself _lhsOwarnings + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule349 #-} + rule349 = \ ((_hdIcontextRanges) :: [Range]) ((_tlIcontextRanges) :: [Range]) -> + _hdIcontextRanges ++ _tlIcontextRanges + {-# INLINE rule350 #-} + rule350 = \ ((_hdIcontextVars) :: [Name]) ((_tlIcontextVars) :: [Name]) -> + _hdIcontextVars ++ _tlIcontextVars + {-# INLINE rule351 #-} + rule351 = \ ((_hdIself) :: ContextItem) ((_tlIself) :: ContextItems) -> + (:) _hdIself _tlIself + {-# INLINE rule352 #-} + rule352 = \ _self -> + _self + {-# INLINE rule353 #-} + rule353 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule354 #-} + rule354 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule355 #-} + rule355 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule356 #-} + rule356 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule357 #-} + rule357 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule358 #-} + rule358 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule359 #-} + rule359 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule360 #-} + rule360 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule361 #-} + rule361 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule362 #-} + rule362 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule363 #-} + rule363 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule364 #-} + rule364 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_ContextItems_Nil #-} +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _lhsOcontextRanges :: [Range] + _lhsOcontextRanges = rule365 () + _lhsOcontextVars :: [Name] + _lhsOcontextVars = rule366 () + _self = rule367 () + _lhsOself :: ContextItems + _lhsOself = rule368 _self + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule369 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule370 _lhsIwarnings + __result_ = T_ContextItems_vOut25 _lhsOcontextRanges _lhsOcontextVars _lhsOmiscerrors _lhsOself _lhsOwarnings + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule365 #-} + rule365 = \ (_ :: ()) -> + [] + {-# INLINE rule366 #-} + rule366 = \ (_ :: ()) -> + [] + {-# INLINE rule367 #-} + rule367 = \ (_ :: ()) -> + [] + {-# INLINE rule368 #-} + rule368 = \ _self -> + _self + {-# INLINE rule369 #-} + rule369 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule370 #-} + rule370 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Declaration ------------------------------------------------- +-- wrapper +data Inh_Declaration = Inh_Declaration { allTypeConstructors_Inh_Declaration :: (Names), allValueConstructors_Inh_Declaration :: (Names), classEnvironment_Inh_Declaration :: (ClassEnvironment), collectScopeInfos_Inh_Declaration :: ([(ScopeInfo, Entity)]), collectTypeConstructors_Inh_Declaration :: ([(Name,Int)]), collectTypeSynonyms_Inh_Declaration :: ([(Name,(Int,Tps -> Tp))]), collectValueConstructors_Inh_Declaration :: ([(Name,TpScheme)]), counter_Inh_Declaration :: (Int), kindErrors_Inh_Declaration :: ([Error]), miscerrors_Inh_Declaration :: ([Error]), namesInScope_Inh_Declaration :: (Names), operatorFixities_Inh_Declaration :: ([(Name,(Int,Assoc))]), options_Inh_Declaration :: ([Option]), orderedTypeSynonyms_Inh_Declaration :: (OrderedTypeSynonyms), previousWasAlsoFB_Inh_Declaration :: (Maybe Name), suspiciousFBs_Inh_Declaration :: ([(Name,Name)]), typeConstructors_Inh_Declaration :: (M.Map Name Int), typeSignatures_Inh_Declaration :: ([(Name,TpScheme)]), valueConstructors_Inh_Declaration :: (M.Map Name TpScheme), warnings_Inh_Declaration :: ([Warning]) } +data Syn_Declaration = Syn_Declaration { collectInstances_Syn_Declaration :: ([(Name, Instance)]), collectScopeInfos_Syn_Declaration :: ([(ScopeInfo, Entity)]), collectTypeConstructors_Syn_Declaration :: ([(Name,Int)]), collectTypeSynonyms_Syn_Declaration :: ([(Name,(Int,Tps -> Tp))]), collectValueConstructors_Syn_Declaration :: ([(Name,TpScheme)]), counter_Syn_Declaration :: (Int), declVarNames_Syn_Declaration :: (Names), kindErrors_Syn_Declaration :: ([Error]), miscerrors_Syn_Declaration :: ([Error]), operatorFixities_Syn_Declaration :: ([(Name,(Int,Assoc))]), previousWasAlsoFB_Syn_Declaration :: (Maybe Name), restrictedNames_Syn_Declaration :: (Names), self_Syn_Declaration :: (Declaration), suspiciousFBs_Syn_Declaration :: ([(Name,Name)]), typeSignatures_Syn_Declaration :: ([(Name,TpScheme)]), unboundNames_Syn_Declaration :: (Names), warnings_Syn_Declaration :: ([Warning]) } +{-# INLINABLE wrap_Declaration #-} +wrap_Declaration :: T_Declaration -> Inh_Declaration -> (Syn_Declaration ) +wrap_Declaration (T_Declaration act) (Inh_Declaration _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings + (T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings) <- return (inv_Declaration_s29 sem arg) + return (Syn_Declaration _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Declaration #-} +sem_Declaration :: Declaration -> T_Declaration +sem_Declaration ( Declaration_Hole range_ id_ ) = sem_Declaration_Hole ( sem_Range range_ ) id_ +sem_Declaration ( Declaration_Type range_ simpletype_ type_ ) = sem_Declaration_Type ( sem_Range range_ ) ( sem_SimpleType simpletype_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Data range_ context_ simpletype_ constructors_ derivings_ ) = sem_Declaration_Data ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructors constructors_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Newtype range_ context_ simpletype_ constructor_ derivings_ ) = sem_Declaration_Newtype ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructor constructor_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Class range_ context_ simpletype_ where_ ) = sem_Declaration_Class ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Instance range_ context_ name_ types_ where_ ) = sem_Declaration_Instance ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Name name_ ) ( sem_Types types_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Default range_ types_ ) = sem_Declaration_Default ( sem_Range range_ ) ( sem_Types types_ ) +sem_Declaration ( Declaration_FunctionBindings range_ bindings_ ) = sem_Declaration_FunctionBindings ( sem_Range range_ ) ( sem_FunctionBindings bindings_ ) +sem_Declaration ( Declaration_PatternBinding range_ pattern_ righthandside_ ) = sem_Declaration_PatternBinding ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Declaration ( Declaration_TypeSignature range_ names_ type_ ) = sem_Declaration_TypeSignature ( sem_Range range_ ) ( sem_Names names_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Fixity range_ fixity_ priority_ operators_ ) = sem_Declaration_Fixity ( sem_Range range_ ) ( sem_Fixity fixity_ ) ( sem_MaybeInt priority_ ) ( sem_Names operators_ ) +sem_Declaration ( Declaration_Empty range_ ) = sem_Declaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Declaration = T_Declaration { + attach_T_Declaration :: Identity (T_Declaration_s29 ) + } +newtype T_Declaration_s29 = C_Declaration_s29 { + inv_Declaration_s29 :: (T_Declaration_v28 ) + } +data T_Declaration_s30 = C_Declaration_s30 +type T_Declaration_v28 = (T_Declaration_vIn28 ) -> (T_Declaration_vOut28 ) +data T_Declaration_vIn28 = T_Declaration_vIn28 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) ([(Name,Int)]) ([(Name,(Int,Tps -> Tp))]) ([(Name,TpScheme)]) (Int) ([Error]) ([Error]) (Names) ([(Name,(Int,Assoc))]) ([Option]) (OrderedTypeSynonyms) (Maybe Name) ([(Name,Name)]) (M.Map Name Int) ([(Name,TpScheme)]) (M.Map Name TpScheme) ([Warning]) +data T_Declaration_vOut28 = T_Declaration_vOut28 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) ([(Name,Int)]) ([(Name,(Int,Tps -> Tp))]) ([(Name,TpScheme)]) (Int) (Names) ([Error]) ([Error]) ([(Name,(Int,Assoc))]) (Maybe Name) (Names) (Declaration) ([(Name,Name)]) ([(Name,TpScheme)]) (Names) ([Warning]) +{-# NOINLINE sem_Declaration_Hole #-} +sem_Declaration_Hole :: T_Range -> (Integer) -> T_Declaration +sem_Declaration_Hole arg_range_ arg_id_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule371 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule372 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule373 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule374 () + _self = rule375 _rangeIself arg_id_ + _lhsOself :: Declaration + _lhsOself = rule376 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule377 _lhsIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule378 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule379 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule380 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule381 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule382 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule383 _lhsImiscerrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule384 _lhsIoperatorFixities + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule385 _lhsIpreviousWasAlsoFB + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule386 _lhsIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule387 _lhsItypeSignatures + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule388 _lhsIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule371 #-} + rule371 = \ (_ :: ()) -> + [] + {-# INLINE rule372 #-} + rule372 = \ (_ :: ()) -> + [] + {-# INLINE rule373 #-} + rule373 = \ (_ :: ()) -> + [] + {-# INLINE rule374 #-} + rule374 = \ (_ :: ()) -> + [] + {-# INLINE rule375 #-} + rule375 = \ ((_rangeIself) :: Range) id_ -> + Declaration_Hole _rangeIself id_ + {-# INLINE rule376 #-} + rule376 = \ _self -> + _self + {-# INLINE rule377 #-} + rule377 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule378 #-} + rule378 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule379 #-} + rule379 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule380 #-} + rule380 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule381 #-} + rule381 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule382 #-} + rule382 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule383 #-} + rule383 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule384 #-} + rule384 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule385 #-} + rule385 = \ ((_lhsIpreviousWasAlsoFB) :: Maybe Name) -> + _lhsIpreviousWasAlsoFB + {-# INLINE rule386 #-} + rule386 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule387 #-} + rule387 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule388 #-} + rule388 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Declaration_Type #-} +sem_Declaration_Type :: T_Range -> T_SimpleType -> T_Type -> T_Declaration +sem_Declaration_Type arg_range_ arg_simpletype_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Type_vOut163 _typeIcontextRange _typeImiscerrors _typeIself _typeItypevariables _typeIwarnings) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOallTypeConstructors _typeOmiscerrors _typeOoptions _typeOtypeConstructors _typeOwarnings) + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule389 _lhsIcollectTypeSynonyms _simpletypeIname _typeSynonymInfo + _typeSynonymInfo = rule390 _simpletypeItypevariables _typeIself + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule391 _lhsIkindErrors _newErrors + _newErrors = rule392 _lhsIallValueConstructors _lhsInamesInScope _lhsItypeConstructors _typeIself + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule393 _lhsIwarnings _unused + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule394 () + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule395 _doubles _lhsImiscerrors _simpletypeItypevariables _undef + _unused = rule396 _simpletypeItypevariables _typeItypevariables + _doubles = rule397 _simpletypeItypevariables + _undef = rule398 _simpletypeItypevariables _typeItypevariables + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule399 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule400 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule401 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule402 () + _self = rule403 _rangeIself _simpletypeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule404 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule405 _lhsIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule406 _lhsIcollectTypeConstructors + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule407 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule408 _lhsIcounter + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule409 _lhsIoperatorFixities + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule410 _lhsIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule411 _lhsItypeSignatures + _typeOallTypeConstructors = rule412 _lhsIallTypeConstructors + _typeOmiscerrors = rule413 _lhsImiscerrors + _typeOoptions = rule414 _lhsIoptions + _typeOtypeConstructors = rule415 _lhsItypeConstructors + _typeOwarnings = rule416 _lhsIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule389 #-} + rule389 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) ((_simpletypeIname) :: Name) _typeSynonymInfo -> + (_simpletypeIname, _typeSynonymInfo) : _lhsIcollectTypeSynonyms + {-# INLINE rule390 #-} + rule390 = \ ((_simpletypeItypevariables) :: Names) ((_typeIself) :: Type) -> + (length _simpletypeItypevariables,\tps -> makeTpFromType (zip _simpletypeItypevariables tps) _typeIself) + {-# INLINE rule391 #-} + rule391 = \ ((_lhsIkindErrors) :: [Error]) _newErrors -> + _newErrors ++ _lhsIkindErrors + {-# INLINE rule392 #-} + rule392 = \ ((_lhsIallValueConstructors) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsItypeConstructors) :: M.Map Name Int) ((_typeIself) :: Type) -> + checkType _lhsItypeConstructors (_lhsInamesInScope ++ _lhsIallValueConstructors) _typeIself + {-# INLINE rule393 #-} + rule393 = \ ((_lhsIwarnings) :: [Warning]) _unused -> + map (Unused TypeVariable) _unused ++ _lhsIwarnings + {-# INLINE rule394 #-} + rule394 = \ (_ :: ()) -> + Nothing + {-# INLINE rule395 #-} + rule395 = \ _doubles ((_lhsImiscerrors) :: [Error]) ((_simpletypeItypevariables) :: Names) _undef -> + concat [ makeDuplicated TypeVariable _doubles + , makeUndefined TypeVariable _undef _simpletypeItypevariables + , _lhsImiscerrors + ] + {-# INLINE rule396 #-} + rule396 = \ ((_simpletypeItypevariables) :: Names) ((_typeItypevariables) :: Names) -> + filter (`notElem` _typeItypevariables) _simpletypeItypevariables + {-# INLINE rule397 #-} + rule397 = \ ((_simpletypeItypevariables) :: Names) -> + filter ((>1) . length) . group . sort $ _simpletypeItypevariables + {-# INLINE rule398 #-} + rule398 = \ ((_simpletypeItypevariables) :: Names) ((_typeItypevariables) :: Names) -> + filter (`notElem` _simpletypeItypevariables) _typeItypevariables + {-# INLINE rule399 #-} + rule399 = \ (_ :: ()) -> + [] + {-# INLINE rule400 #-} + rule400 = \ (_ :: ()) -> + [] + {-# INLINE rule401 #-} + rule401 = \ (_ :: ()) -> + [] + {-# INLINE rule402 #-} + rule402 = \ (_ :: ()) -> + [] + {-# INLINE rule403 #-} + rule403 = \ ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_typeIself) :: Type) -> + Declaration_Type _rangeIself _simpletypeIself _typeIself + {-# INLINE rule404 #-} + rule404 = \ _self -> + _self + {-# INLINE rule405 #-} + rule405 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule406 #-} + rule406 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule407 #-} + rule407 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule408 #-} + rule408 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule409 #-} + rule409 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule410 #-} + rule410 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule411 #-} + rule411 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule412 #-} + rule412 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule413 #-} + rule413 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule414 #-} + rule414 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule415 #-} + rule415 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule416 #-} + rule416 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Declaration_Data #-} +sem_Declaration_Data :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructors -> T_Names -> T_Declaration +sem_Declaration_Data arg_range_ arg_context_ arg_simpletype_ arg_constructors_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorsX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_constructors_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIcontextRanges _contextIcontextVars _contextImiscerrors _contextIself _contextIwarnings) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 _contextOallTypeConstructors _contextOmiscerrors _contextOoptions _contextOtypeConstructors _contextOwarnings) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructors_vOut19 _constructorsIcollectValueConstructors _constructorsIcounter _constructorsIkindErrors _constructorsImiscerrors _constructorsIparameterTypes _constructorsIself _constructorsItypevariables _constructorsIunboundNames _constructorsIwarnings) = inv_Constructors_s20 _constructorsX20 (T_Constructors_vIn19 _constructorsOallTypeConstructors _constructorsOallValueConstructors _constructorsOcollectValueConstructors _constructorsOcounter _constructorsOkindErrors _constructorsOmiscerrors _constructorsOnamesInScope _constructorsOoptions _constructorsOsimpletype _constructorsOtypeConstructors _constructorsOvalueConstructors _constructorsOwarnings) + (T_Names_vOut115 _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule417 _lhsIcollectTypeConstructors _simpletypeIname _simpletypeItypevariables + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule418 _derivingsIself _simpletypeIname _simpletypeItypevariables + _constructorsOsimpletype = rule419 _simpletypeIself + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule420 _lhsIwarnings _unused + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule421 () + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule422 _cantDer _doubles _lhsImiscerrors _simpletypeItypevariables _undef _unknCls + _unused = rule423 _constructorsItypevariables _simpletypeItypevariables + _doubles = rule424 _simpletypeItypevariables + _undef = rule425 _constructorsItypevariables _simpletypeItypevariables + _unknCls = rule426 _derivingsIself + _cantDer = rule427 _constructorsIparameterTypes _derivingsIself _lhsIclassEnvironment _lhsIorderedTypeSynonyms + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule428 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule429 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule430 _constructorsIunboundNames + _self = rule431 _constructorsIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule432 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule433 _lhsIcollectScopeInfos + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule434 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule435 _constructorsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule436 _constructorsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule437 _constructorsIkindErrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule438 _lhsIoperatorFixities + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule439 _lhsIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule440 _lhsItypeSignatures + _contextOallTypeConstructors = rule441 _lhsIallTypeConstructors + _contextOmiscerrors = rule442 _lhsImiscerrors + _contextOoptions = rule443 _lhsIoptions + _contextOtypeConstructors = rule444 _lhsItypeConstructors + _contextOwarnings = rule445 _lhsIwarnings + _constructorsOallTypeConstructors = rule446 _lhsIallTypeConstructors + _constructorsOallValueConstructors = rule447 _lhsIallValueConstructors + _constructorsOcollectValueConstructors = rule448 _lhsIcollectValueConstructors + _constructorsOcounter = rule449 _lhsIcounter + _constructorsOkindErrors = rule450 _lhsIkindErrors + _constructorsOmiscerrors = rule451 _contextImiscerrors + _constructorsOnamesInScope = rule452 _lhsInamesInScope + _constructorsOoptions = rule453 _lhsIoptions + _constructorsOtypeConstructors = rule454 _lhsItypeConstructors + _constructorsOvalueConstructors = rule455 _lhsIvalueConstructors + _constructorsOwarnings = rule456 _contextIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule417 #-} + rule417 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) ((_simpletypeIname) :: Name) ((_simpletypeItypevariables) :: Names) -> + (_simpletypeIname,length _simpletypeItypevariables) : _lhsIcollectTypeConstructors + {-# INLINE rule418 #-} + rule418 = \ ((_derivingsIself) :: Names) ((_simpletypeIname) :: Name) ((_simpletypeItypevariables) :: Names) -> + [ (cl, makeInstance (show cl) (length _simpletypeItypevariables) (show _simpletypeIname) ) + | cl <- _derivingsIself + ] + {-# INLINE rule419 #-} + rule419 = \ ((_simpletypeIself) :: SimpleType) -> + _simpletypeIself + {-# INLINE rule420 #-} + rule420 = \ ((_lhsIwarnings) :: [Warning]) _unused -> + map (Unused TypeVariable) _unused ++ _lhsIwarnings + {-# INLINE rule421 #-} + rule421 = \ (_ :: ()) -> + Nothing + {-# INLINE rule422 #-} + rule422 = \ _cantDer _doubles ((_lhsImiscerrors) :: [Error]) ((_simpletypeItypevariables) :: Names) _undef _unknCls -> + concat [ makeDuplicated TypeVariable _doubles + , makeUndefined TypeVariable _undef _simpletypeItypevariables + , _lhsImiscerrors + , _unknCls + , if null _unknCls then _cantDer else [] + ] + {-# INLINE rule423 #-} + rule423 = \ ((_constructorsItypevariables) :: Names) ((_simpletypeItypevariables) :: Names) -> + filter (`notElem` _constructorsItypevariables) _simpletypeItypevariables + {-# INLINE rule424 #-} + rule424 = \ ((_simpletypeItypevariables) :: Names) -> + filter ((>1) . length) . group . sort $ _simpletypeItypevariables + {-# INLINE rule425 #-} + rule425 = \ ((_constructorsItypevariables) :: Names) ((_simpletypeItypevariables) :: Names) -> + filter (`notElem` _simpletypeItypevariables) _constructorsItypevariables + {-# INLINE rule426 #-} + rule426 = \ ((_derivingsIself) :: Names) -> + [ if className `elem` [ "Num", "Enum", "Ord" ] + then NonDerivableClass c + else UnknownClass c + | c <- _derivingsIself, let className = show c + , className `notElem` ["Show", "Eq"] + ] + {-# INLINE rule427 #-} + rule427 = \ ((_constructorsIparameterTypes) :: Tps) ((_derivingsIself) :: Names) ((_lhsIclassEnvironment) :: ClassEnvironment) ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + [ CannotDerive c [ tp | ReductionError (Predicate _ tp) <- errs ] + | c <- _derivingsIself + , let preds = map (Predicate (show c)) _constructorsIparameterTypes + (_, errs) = contextReduction _lhsIorderedTypeSynonyms _lhsIclassEnvironment preds + , not (null errs) + ] + {-# INLINE rule428 #-} + rule428 = \ (_ :: ()) -> + [] + {-# INLINE rule429 #-} + rule429 = \ (_ :: ()) -> + [] + {-# INLINE rule430 #-} + rule430 = \ ((_constructorsIunboundNames) :: Names) -> + _constructorsIunboundNames + {-# INLINE rule431 #-} + rule431 = \ ((_constructorsIself) :: Constructors) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Data _rangeIself _contextIself _simpletypeIself _constructorsIself _derivingsIself + {-# INLINE rule432 #-} + rule432 = \ _self -> + _self + {-# INLINE rule433 #-} + rule433 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule434 #-} + rule434 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule435 #-} + rule435 = \ ((_constructorsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _constructorsIcollectValueConstructors + {-# INLINE rule436 #-} + rule436 = \ ((_constructorsIcounter) :: Int) -> + _constructorsIcounter + {-# INLINE rule437 #-} + rule437 = \ ((_constructorsIkindErrors) :: [Error]) -> + _constructorsIkindErrors + {-# INLINE rule438 #-} + rule438 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule439 #-} + rule439 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule440 #-} + rule440 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule441 #-} + rule441 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule442 #-} + rule442 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule443 #-} + rule443 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule444 #-} + rule444 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule445 #-} + rule445 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule446 #-} + rule446 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule447 #-} + rule447 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule448 #-} + rule448 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule449 #-} + rule449 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule450 #-} + rule450 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule451 #-} + rule451 = \ ((_contextImiscerrors) :: [Error]) -> + _contextImiscerrors + {-# INLINE rule452 #-} + rule452 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule453 #-} + rule453 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule454 #-} + rule454 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule455 #-} + rule455 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule456 #-} + rule456 = \ ((_contextIwarnings) :: [Warning]) -> + _contextIwarnings +{-# NOINLINE sem_Declaration_Newtype #-} +sem_Declaration_Newtype :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructor -> T_Names -> T_Declaration +sem_Declaration_Newtype arg_range_ arg_context_ arg_simpletype_ arg_constructor_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_constructor_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIcontextRanges _contextIcontextVars _contextImiscerrors _contextIself _contextIwarnings) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 _contextOallTypeConstructors _contextOmiscerrors _contextOoptions _contextOtypeConstructors _contextOwarnings) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructor_vOut16 _constructorIcollectValueConstructors _constructorIcounter _constructorIkindErrors _constructorImiscerrors _constructorIparameterTypes _constructorIself _constructorItypevariables _constructorIunboundNames _constructorIwarnings) = inv_Constructor_s17 _constructorX17 (T_Constructor_vIn16 _constructorOallTypeConstructors _constructorOallValueConstructors _constructorOcollectValueConstructors _constructorOcounter _constructorOkindErrors _constructorOmiscerrors _constructorOnamesInScope _constructorOoptions _constructorOsimpletype _constructorOtypeConstructors _constructorOvalueConstructors _constructorOwarnings) + (T_Names_vOut115 _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _constructorOsimpletype = rule457 _simpletypeIself + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule458 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule459 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule460 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule461 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule462 _constructorIunboundNames + _self = rule463 _constructorIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule464 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule465 _lhsIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule466 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule467 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule468 _constructorIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule469 _constructorIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule470 _constructorIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule471 _constructorImiscerrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule472 _lhsIoperatorFixities + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule473 _lhsIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule474 _lhsItypeSignatures + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule475 _constructorIwarnings + _contextOallTypeConstructors = rule476 _lhsIallTypeConstructors + _contextOmiscerrors = rule477 _lhsImiscerrors + _contextOoptions = rule478 _lhsIoptions + _contextOtypeConstructors = rule479 _lhsItypeConstructors + _contextOwarnings = rule480 _lhsIwarnings + _constructorOallTypeConstructors = rule481 _lhsIallTypeConstructors + _constructorOallValueConstructors = rule482 _lhsIallValueConstructors + _constructorOcollectValueConstructors = rule483 _lhsIcollectValueConstructors + _constructorOcounter = rule484 _lhsIcounter + _constructorOkindErrors = rule485 _lhsIkindErrors + _constructorOmiscerrors = rule486 _contextImiscerrors + _constructorOnamesInScope = rule487 _lhsInamesInScope + _constructorOoptions = rule488 _lhsIoptions + _constructorOtypeConstructors = rule489 _lhsItypeConstructors + _constructorOvalueConstructors = rule490 _lhsIvalueConstructors + _constructorOwarnings = rule491 _contextIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule457 #-} + rule457 = \ ((_simpletypeIself) :: SimpleType) -> + _simpletypeIself + {-# INLINE rule458 #-} + rule458 = \ (_ :: ()) -> + Nothing + {-# INLINE rule459 #-} + rule459 = \ (_ :: ()) -> + [] + {-# INLINE rule460 #-} + rule460 = \ (_ :: ()) -> + [] + {-# INLINE rule461 #-} + rule461 = \ (_ :: ()) -> + [] + {-# INLINE rule462 #-} + rule462 = \ ((_constructorIunboundNames) :: Names) -> + _constructorIunboundNames + {-# INLINE rule463 #-} + rule463 = \ ((_constructorIself) :: Constructor) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Newtype _rangeIself _contextIself _simpletypeIself _constructorIself _derivingsIself + {-# INLINE rule464 #-} + rule464 = \ _self -> + _self + {-# INLINE rule465 #-} + rule465 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule466 #-} + rule466 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule467 #-} + rule467 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule468 #-} + rule468 = \ ((_constructorIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _constructorIcollectValueConstructors + {-# INLINE rule469 #-} + rule469 = \ ((_constructorIcounter) :: Int) -> + _constructorIcounter + {-# INLINE rule470 #-} + rule470 = \ ((_constructorIkindErrors) :: [Error]) -> + _constructorIkindErrors + {-# INLINE rule471 #-} + rule471 = \ ((_constructorImiscerrors) :: [Error]) -> + _constructorImiscerrors + {-# INLINE rule472 #-} + rule472 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule473 #-} + rule473 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule474 #-} + rule474 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule475 #-} + rule475 = \ ((_constructorIwarnings) :: [Warning]) -> + _constructorIwarnings + {-# INLINE rule476 #-} + rule476 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule477 #-} + rule477 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule478 #-} + rule478 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule479 #-} + rule479 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule480 #-} + rule480 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule481 #-} + rule481 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule482 #-} + rule482 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule483 #-} + rule483 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule484 #-} + rule484 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule485 #-} + rule485 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule486 #-} + rule486 = \ ((_contextImiscerrors) :: [Error]) -> + _contextImiscerrors + {-# INLINE rule487 #-} + rule487 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule488 #-} + rule488 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule489 #-} + rule489 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule490 #-} + rule490 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule491 #-} + rule491 = \ ((_contextIwarnings) :: [Warning]) -> + _contextIwarnings +{-# NOINLINE sem_Declaration_Class #-} +sem_Declaration_Class :: T_Range -> T_ContextItems -> T_SimpleType -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Class arg_range_ arg_context_ arg_simpletype_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIcontextRanges _contextIcontextVars _contextImiscerrors _contextIself _contextIwarnings) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 _contextOallTypeConstructors _contextOmiscerrors _contextOoptions _contextOtypeConstructors _contextOwarnings) + (T_SimpleType_vOut151 _simpletypeIname _simpletypeIself _simpletypeItypevariables) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_MaybeDeclarations_vOut88 _whereIcollectInstances _whereIcollectScopeInfos _whereIcounter _whereIkindErrors _whereImiscerrors _whereInamesInScope _whereIself _whereIunboundNames _whereIwarnings) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOallTypeConstructors _whereOallValueConstructors _whereOclassEnvironment _whereOcollectScopeInfos _whereOcounter _whereOkindErrors _whereOmiscerrors _whereOnamesInScope _whereOoptions _whereOorderedTypeSynonyms _whereOtypeConstructors _whereOunboundNames _whereOvalueConstructors _whereOwarnings) + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule492 () + (_assumptions,_constraints,_unboundNames) = rule493 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule494 _whereIcollectInstances + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule495 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule496 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule497 _unboundNames + _self = rule498 _contextIself _rangeIself _simpletypeIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule499 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule500 _whereIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule501 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule502 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule503 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule504 _whereIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule505 _whereIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule506 _whereImiscerrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule507 _lhsIoperatorFixities + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule508 _lhsIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule509 _lhsItypeSignatures + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule510 _whereIwarnings + _contextOallTypeConstructors = rule511 _lhsIallTypeConstructors + _contextOmiscerrors = rule512 _lhsImiscerrors + _contextOoptions = rule513 _lhsIoptions + _contextOtypeConstructors = rule514 _lhsItypeConstructors + _contextOwarnings = rule515 _lhsIwarnings + _whereOallTypeConstructors = rule516 _lhsIallTypeConstructors + _whereOallValueConstructors = rule517 _lhsIallValueConstructors + _whereOclassEnvironment = rule518 _lhsIclassEnvironment + _whereOcollectScopeInfos = rule519 _lhsIcollectScopeInfos + _whereOcounter = rule520 _lhsIcounter + _whereOkindErrors = rule521 _lhsIkindErrors + _whereOmiscerrors = rule522 _contextImiscerrors + _whereOnamesInScope = rule523 _lhsInamesInScope + _whereOoptions = rule524 _lhsIoptions + _whereOorderedTypeSynonyms = rule525 _lhsIorderedTypeSynonyms + _whereOtypeConstructors = rule526 _lhsItypeConstructors + _whereOunboundNames = rule527 _unboundNames + _whereOvalueConstructors = rule528 _lhsIvalueConstructors + _whereOwarnings = rule529 _contextIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule492 #-} + rule492 = \ (_ :: ()) -> + Nothing + {-# INLINE rule493 #-} + rule493 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "Declaration.Class" + {-# INLINE rule494 #-} + rule494 = \ ((_whereIcollectInstances) :: [(Name, Instance)]) -> + _whereIcollectInstances + {-# INLINE rule495 #-} + rule495 = \ (_ :: ()) -> + [] + {-# INLINE rule496 #-} + rule496 = \ (_ :: ()) -> + [] + {-# INLINE rule497 #-} + rule497 = \ _unboundNames -> + _unboundNames + {-# INLINE rule498 #-} + rule498 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Class _rangeIself _contextIself _simpletypeIself _whereIself + {-# INLINE rule499 #-} + rule499 = \ _self -> + _self + {-# INLINE rule500 #-} + rule500 = \ ((_whereIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _whereIcollectScopeInfos + {-# INLINE rule501 #-} + rule501 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule502 #-} + rule502 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule503 #-} + rule503 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule504 #-} + rule504 = \ ((_whereIcounter) :: Int) -> + _whereIcounter + {-# INLINE rule505 #-} + rule505 = \ ((_whereIkindErrors) :: [Error]) -> + _whereIkindErrors + {-# INLINE rule506 #-} + rule506 = \ ((_whereImiscerrors) :: [Error]) -> + _whereImiscerrors + {-# INLINE rule507 #-} + rule507 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule508 #-} + rule508 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule509 #-} + rule509 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule510 #-} + rule510 = \ ((_whereIwarnings) :: [Warning]) -> + _whereIwarnings + {-# INLINE rule511 #-} + rule511 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule512 #-} + rule512 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule513 #-} + rule513 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule514 #-} + rule514 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule515 #-} + rule515 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule516 #-} + rule516 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule517 #-} + rule517 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule518 #-} + rule518 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule519 #-} + rule519 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule520 #-} + rule520 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule521 #-} + rule521 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule522 #-} + rule522 = \ ((_contextImiscerrors) :: [Error]) -> + _contextImiscerrors + {-# INLINE rule523 #-} + rule523 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule524 #-} + rule524 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule525 #-} + rule525 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule526 #-} + rule526 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule527 #-} + rule527 = \ _unboundNames -> + _unboundNames + {-# INLINE rule528 #-} + rule528 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule529 #-} + rule529 = \ ((_contextIwarnings) :: [Warning]) -> + _contextIwarnings +{-# NOINLINE sem_Declaration_Instance #-} +sem_Declaration_Instance :: T_Range -> T_ContextItems -> T_Name -> T_Types -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Instance arg_range_ arg_context_ arg_name_ arg_types_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIcontextRanges _contextIcontextVars _contextImiscerrors _contextIself _contextIwarnings) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 _contextOallTypeConstructors _contextOmiscerrors _contextOoptions _contextOtypeConstructors _contextOwarnings) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesImiscerrors _typesIself _typesItypevariables _typesIwarnings) = inv_Types_s167 _typesX167 (T_Types_vIn166 _typesOallTypeConstructors _typesOmiscerrors _typesOoptions _typesOtypeConstructors _typesOwarnings) + (T_MaybeDeclarations_vOut88 _whereIcollectInstances _whereIcollectScopeInfos _whereIcounter _whereIkindErrors _whereImiscerrors _whereInamesInScope _whereIself _whereIunboundNames _whereIwarnings) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOallTypeConstructors _whereOallValueConstructors _whereOclassEnvironment _whereOcollectScopeInfos _whereOcounter _whereOkindErrors _whereOmiscerrors _whereOnamesInScope _whereOoptions _whereOorderedTypeSynonyms _whereOtypeConstructors _whereOunboundNames _whereOvalueConstructors _whereOwarnings) + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule530 () + (_assumptions,_constraints,_unboundNames) = rule531 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule532 _whereIcollectInstances + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule533 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule534 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule535 _unboundNames + _self = rule536 _contextIself _nameIself _rangeIself _typesIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule537 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule538 _whereIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule539 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule540 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule541 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule542 _whereIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule543 _whereIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule544 _whereImiscerrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule545 _lhsIoperatorFixities + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule546 _lhsIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule547 _lhsItypeSignatures + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule548 _whereIwarnings + _contextOallTypeConstructors = rule549 _lhsIallTypeConstructors + _contextOmiscerrors = rule550 _lhsImiscerrors + _contextOoptions = rule551 _lhsIoptions + _contextOtypeConstructors = rule552 _lhsItypeConstructors + _contextOwarnings = rule553 _lhsIwarnings + _typesOallTypeConstructors = rule554 _lhsIallTypeConstructors + _typesOmiscerrors = rule555 _contextImiscerrors + _typesOoptions = rule556 _lhsIoptions + _typesOtypeConstructors = rule557 _lhsItypeConstructors + _typesOwarnings = rule558 _contextIwarnings + _whereOallTypeConstructors = rule559 _lhsIallTypeConstructors + _whereOallValueConstructors = rule560 _lhsIallValueConstructors + _whereOclassEnvironment = rule561 _lhsIclassEnvironment + _whereOcollectScopeInfos = rule562 _lhsIcollectScopeInfos + _whereOcounter = rule563 _lhsIcounter + _whereOkindErrors = rule564 _lhsIkindErrors + _whereOmiscerrors = rule565 _typesImiscerrors + _whereOnamesInScope = rule566 _lhsInamesInScope + _whereOoptions = rule567 _lhsIoptions + _whereOorderedTypeSynonyms = rule568 _lhsIorderedTypeSynonyms + _whereOtypeConstructors = rule569 _lhsItypeConstructors + _whereOunboundNames = rule570 _unboundNames + _whereOvalueConstructors = rule571 _lhsIvalueConstructors + _whereOwarnings = rule572 _typesIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule530 #-} + rule530 = \ (_ :: ()) -> + Nothing + {-# INLINE rule531 #-} + rule531 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "Declaration.Instance" + {-# INLINE rule532 #-} + rule532 = \ ((_whereIcollectInstances) :: [(Name, Instance)]) -> + _whereIcollectInstances + {-# INLINE rule533 #-} + rule533 = \ (_ :: ()) -> + [] + {-# INLINE rule534 #-} + rule534 = \ (_ :: ()) -> + [] + {-# INLINE rule535 #-} + rule535 = \ _unboundNames -> + _unboundNames + {-# INLINE rule536 #-} + rule536 = \ ((_contextIself) :: ContextItems) ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Instance _rangeIself _contextIself _nameIself _typesIself _whereIself + {-# INLINE rule537 #-} + rule537 = \ _self -> + _self + {-# INLINE rule538 #-} + rule538 = \ ((_whereIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _whereIcollectScopeInfos + {-# INLINE rule539 #-} + rule539 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule540 #-} + rule540 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule541 #-} + rule541 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule542 #-} + rule542 = \ ((_whereIcounter) :: Int) -> + _whereIcounter + {-# INLINE rule543 #-} + rule543 = \ ((_whereIkindErrors) :: [Error]) -> + _whereIkindErrors + {-# INLINE rule544 #-} + rule544 = \ ((_whereImiscerrors) :: [Error]) -> + _whereImiscerrors + {-# INLINE rule545 #-} + rule545 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule546 #-} + rule546 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule547 #-} + rule547 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule548 #-} + rule548 = \ ((_whereIwarnings) :: [Warning]) -> + _whereIwarnings + {-# INLINE rule549 #-} + rule549 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule550 #-} + rule550 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule551 #-} + rule551 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule552 #-} + rule552 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule553 #-} + rule553 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule554 #-} + rule554 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule555 #-} + rule555 = \ ((_contextImiscerrors) :: [Error]) -> + _contextImiscerrors + {-# INLINE rule556 #-} + rule556 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule557 #-} + rule557 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule558 #-} + rule558 = \ ((_contextIwarnings) :: [Warning]) -> + _contextIwarnings + {-# INLINE rule559 #-} + rule559 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule560 #-} + rule560 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule561 #-} + rule561 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule562 #-} + rule562 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule563 #-} + rule563 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule564 #-} + rule564 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule565 #-} + rule565 = \ ((_typesImiscerrors) :: [Error]) -> + _typesImiscerrors + {-# INLINE rule566 #-} + rule566 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule567 #-} + rule567 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule568 #-} + rule568 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule569 #-} + rule569 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule570 #-} + rule570 = \ _unboundNames -> + _unboundNames + {-# INLINE rule571 #-} + rule571 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule572 #-} + rule572 = \ ((_typesIwarnings) :: [Warning]) -> + _typesIwarnings +{-# NOINLINE sem_Declaration_Default #-} +sem_Declaration_Default :: T_Range -> T_Types -> T_Declaration +sem_Declaration_Default arg_range_ arg_types_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Types_vOut166 _typesImiscerrors _typesIself _typesItypevariables _typesIwarnings) = inv_Types_s167 _typesX167 (T_Types_vIn166 _typesOallTypeConstructors _typesOmiscerrors _typesOoptions _typesOtypeConstructors _typesOwarnings) + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule573 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule574 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule575 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule576 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule577 () + _self = rule578 _rangeIself _typesIself + _lhsOself :: Declaration + _lhsOself = rule579 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule580 _lhsIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule581 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule582 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule583 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule584 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule585 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule586 _typesImiscerrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule587 _lhsIoperatorFixities + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule588 _lhsIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule589 _lhsItypeSignatures + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule590 _typesIwarnings + _typesOallTypeConstructors = rule591 _lhsIallTypeConstructors + _typesOmiscerrors = rule592 _lhsImiscerrors + _typesOoptions = rule593 _lhsIoptions + _typesOtypeConstructors = rule594 _lhsItypeConstructors + _typesOwarnings = rule595 _lhsIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule573 #-} + rule573 = \ (_ :: ()) -> + Nothing + {-# INLINE rule574 #-} + rule574 = \ (_ :: ()) -> + [] + {-# INLINE rule575 #-} + rule575 = \ (_ :: ()) -> + [] + {-# INLINE rule576 #-} + rule576 = \ (_ :: ()) -> + [] + {-# INLINE rule577 #-} + rule577 = \ (_ :: ()) -> + [] + {-# INLINE rule578 #-} + rule578 = \ ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + Declaration_Default _rangeIself _typesIself + {-# INLINE rule579 #-} + rule579 = \ _self -> + _self + {-# INLINE rule580 #-} + rule580 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule581 #-} + rule581 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule582 #-} + rule582 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule583 #-} + rule583 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule584 #-} + rule584 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule585 #-} + rule585 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule586 #-} + rule586 = \ ((_typesImiscerrors) :: [Error]) -> + _typesImiscerrors + {-# INLINE rule587 #-} + rule587 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule588 #-} + rule588 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule589 #-} + rule589 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule590 #-} + rule590 = \ ((_typesIwarnings) :: [Warning]) -> + _typesIwarnings + {-# INLINE rule591 #-} + rule591 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule592 #-} + rule592 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule593 #-} + rule593 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule594 #-} + rule594 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule595 #-} + rule595 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Declaration_FunctionBindings #-} +sem_Declaration_FunctionBindings :: T_Range -> T_FunctionBindings -> T_Declaration +sem_Declaration_FunctionBindings arg_range_ arg_bindings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _bindingsX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_bindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBindings_vOut58 _bindingsIarities _bindingsIcollectInstances _bindingsIcollectScopeInfos _bindingsIcounter _bindingsIkindErrors _bindingsImiscerrors _bindingsIname _bindingsIself _bindingsIunboundNames _bindingsIwarnings) = inv_FunctionBindings_s59 _bindingsX59 (T_FunctionBindings_vIn58 _bindingsOallTypeConstructors _bindingsOallValueConstructors _bindingsOclassEnvironment _bindingsOcollectScopeInfos _bindingsOcounter _bindingsOkindErrors _bindingsOmiscerrors _bindingsOnamesInScope _bindingsOoptions _bindingsOorderedTypeSynonyms _bindingsOtypeConstructors _bindingsOvalueConstructors _bindingsOwarnings) + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule596 _bindingsIname + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule597 _bindingsIname + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule598 _bindingsIname _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule599 _arityErrors _bindingsImiscerrors + _arityErrors = rule600 _bindingsIarities _bindingsIname _rangeIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule601 _bindingsIcollectInstances + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule602 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule603 _bindingsIunboundNames + _self = rule604 _bindingsIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule605 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule606 _bindingsIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule607 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule608 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule609 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule610 _bindingsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule611 _bindingsIkindErrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule612 _lhsIoperatorFixities + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule613 _lhsItypeSignatures + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule614 _bindingsIwarnings + _bindingsOallTypeConstructors = rule615 _lhsIallTypeConstructors + _bindingsOallValueConstructors = rule616 _lhsIallValueConstructors + _bindingsOclassEnvironment = rule617 _lhsIclassEnvironment + _bindingsOcollectScopeInfos = rule618 _lhsIcollectScopeInfos + _bindingsOcounter = rule619 _lhsIcounter + _bindingsOkindErrors = rule620 _lhsIkindErrors + _bindingsOmiscerrors = rule621 _lhsImiscerrors + _bindingsOnamesInScope = rule622 _lhsInamesInScope + _bindingsOoptions = rule623 _lhsIoptions + _bindingsOorderedTypeSynonyms = rule624 _lhsIorderedTypeSynonyms + _bindingsOtypeConstructors = rule625 _lhsItypeConstructors + _bindingsOvalueConstructors = rule626 _lhsIvalueConstructors + _bindingsOwarnings = rule627 _lhsIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule596 #-} + rule596 = \ ((_bindingsIname) :: Name) -> + [_bindingsIname] + {-# INLINE rule597 #-} + rule597 = \ ((_bindingsIname) :: Name) -> + Just _bindingsIname + {-# INLINE rule598 #-} + rule598 = \ ((_bindingsIname) :: Name) ((_lhsIpreviousWasAlsoFB) :: Maybe Name) ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + case _lhsIpreviousWasAlsoFB of + Just name | show name `similar` show _bindingsIname + -> (name,_bindingsIname) : _lhsIsuspiciousFBs + _ -> _lhsIsuspiciousFBs + {-# INLINE rule599 #-} + rule599 = \ _arityErrors ((_bindingsImiscerrors) :: [Error]) -> + _arityErrors ++ _bindingsImiscerrors + {-# INLINE rule600 #-} + rule600 = \ ((_bindingsIarities) :: [Int] ) ((_bindingsIname) :: Name) ((_rangeIself) :: Range) -> + if all (== head _bindingsIarities) _bindingsIarities + then [] + else [ DefArityMismatch _bindingsIname (mode _bindingsIarities) _rangeIself ] + {-# INLINE rule601 #-} + rule601 = \ ((_bindingsIcollectInstances) :: [(Name, Instance)]) -> + _bindingsIcollectInstances + {-# INLINE rule602 #-} + rule602 = \ (_ :: ()) -> + [] + {-# INLINE rule603 #-} + rule603 = \ ((_bindingsIunboundNames) :: Names) -> + _bindingsIunboundNames + {-# INLINE rule604 #-} + rule604 = \ ((_bindingsIself) :: FunctionBindings) ((_rangeIself) :: Range) -> + Declaration_FunctionBindings _rangeIself _bindingsIself + {-# INLINE rule605 #-} + rule605 = \ _self -> + _self + {-# INLINE rule606 #-} + rule606 = \ ((_bindingsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _bindingsIcollectScopeInfos + {-# INLINE rule607 #-} + rule607 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule608 #-} + rule608 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule609 #-} + rule609 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule610 #-} + rule610 = \ ((_bindingsIcounter) :: Int) -> + _bindingsIcounter + {-# INLINE rule611 #-} + rule611 = \ ((_bindingsIkindErrors) :: [Error]) -> + _bindingsIkindErrors + {-# INLINE rule612 #-} + rule612 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule613 #-} + rule613 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule614 #-} + rule614 = \ ((_bindingsIwarnings) :: [Warning]) -> + _bindingsIwarnings + {-# INLINE rule615 #-} + rule615 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule616 #-} + rule616 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule617 #-} + rule617 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule618 #-} + rule618 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule619 #-} + rule619 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule620 #-} + rule620 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule621 #-} + rule621 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule622 #-} + rule622 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule623 #-} + rule623 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule624 #-} + rule624 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule625 #-} + rule625 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule626 #-} + rule626 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule627 #-} + rule627 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Declaration_PatternBinding #-} +sem_Declaration_PatternBinding :: T_Range -> T_Pattern -> T_RightHandSide -> T_Declaration +sem_Declaration_PatternBinding arg_range_ arg_pattern_ arg_righthandside_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIcollectScopeInfos _patternIcounter _patternImiscerrors _patternIpatVarNames _patternIself _patternIunboundNames _patternIwarnings) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOallTypeConstructors _patternOallValueConstructors _patternOcollectScopeInfos _patternOcounter _patternOlhsPattern _patternOmiscerrors _patternOnamesInScope _patternOtypeConstructors _patternOvalueConstructors _patternOwarnings) + (T_RightHandSide_vOut148 _righthandsideIcollectInstances _righthandsideIcollectScopeInfos _righthandsideIcounter _righthandsideIkindErrors _righthandsideImiscerrors _righthandsideIself _righthandsideIunboundNames _righthandsideIwarnings) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOallTypeConstructors _righthandsideOallValueConstructors _righthandsideOclassEnvironment _righthandsideOcollectScopeInfos _righthandsideOcounter _righthandsideOkindErrors _righthandsideOmiscerrors _righthandsideOnamesInScope _righthandsideOoptions _righthandsideOorderedTypeSynonyms _righthandsideOtypeConstructors _righthandsideOvalueConstructors _righthandsideOwarnings) + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule628 _patternIpatVarNames + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule629 () + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule630 _patternDefinesNoVarsErrors _righthandsideImiscerrors + _patternDefinesNoVarsErrors = rule631 _patternIpatVarNames _patternIself + _patternOlhsPattern = rule632 _patternIself + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule633 _patternIpatVarNames _patternIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule634 _righthandsideIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule635 _patternIunboundNames _righthandsideIunboundNames + _self = rule636 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Declaration + _lhsOself = rule637 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule638 _righthandsideIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule639 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule640 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule641 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule642 _righthandsideIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule643 _righthandsideIkindErrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule644 _lhsIoperatorFixities + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule645 _lhsIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule646 _lhsItypeSignatures + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule647 _righthandsideIwarnings + _patternOallTypeConstructors = rule648 _lhsIallTypeConstructors + _patternOallValueConstructors = rule649 _lhsIallValueConstructors + _patternOcollectScopeInfos = rule650 _lhsIcollectScopeInfos + _patternOcounter = rule651 _lhsIcounter + _patternOmiscerrors = rule652 _lhsImiscerrors + _patternOnamesInScope = rule653 _lhsInamesInScope + _patternOtypeConstructors = rule654 _lhsItypeConstructors + _patternOvalueConstructors = rule655 _lhsIvalueConstructors + _patternOwarnings = rule656 _lhsIwarnings + _righthandsideOallTypeConstructors = rule657 _lhsIallTypeConstructors + _righthandsideOallValueConstructors = rule658 _lhsIallValueConstructors + _righthandsideOclassEnvironment = rule659 _lhsIclassEnvironment + _righthandsideOcollectScopeInfos = rule660 _patternIcollectScopeInfos + _righthandsideOcounter = rule661 _patternIcounter + _righthandsideOkindErrors = rule662 _lhsIkindErrors + _righthandsideOmiscerrors = rule663 _patternImiscerrors + _righthandsideOnamesInScope = rule664 _lhsInamesInScope + _righthandsideOoptions = rule665 _lhsIoptions + _righthandsideOorderedTypeSynonyms = rule666 _lhsIorderedTypeSynonyms + _righthandsideOtypeConstructors = rule667 _lhsItypeConstructors + _righthandsideOvalueConstructors = rule668 _lhsIvalueConstructors + _righthandsideOwarnings = rule669 _patternIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule628 #-} + rule628 = \ ((_patternIpatVarNames) :: Names) -> + _patternIpatVarNames + {-# INLINE rule629 #-} + rule629 = \ (_ :: ()) -> + Nothing + {-# INLINE rule630 #-} + rule630 = \ _patternDefinesNoVarsErrors ((_righthandsideImiscerrors) :: [Error]) -> + _patternDefinesNoVarsErrors ++ _righthandsideImiscerrors + {-# INLINE rule631 #-} + rule631 = \ ((_patternIpatVarNames) :: Names) ((_patternIself) :: Pattern) -> + if null _patternIpatVarNames + then [ PatternDefinesNoVars (getPatRange _patternIself) ] + else [] + {-# INLINE rule632 #-} + rule632 = \ ((_patternIself) :: Pattern) -> + simplePattern _patternIself + {-# INLINE rule633 #-} + rule633 = \ ((_patternIpatVarNames) :: Names) ((_patternIself) :: Pattern) -> + if isSimplePattern _patternIself + then [] + else _patternIpatVarNames + {-# INLINE rule634 #-} + rule634 = \ ((_righthandsideIcollectInstances) :: [(Name, Instance)]) -> + _righthandsideIcollectInstances + {-# INLINE rule635 #-} + rule635 = \ ((_patternIunboundNames) :: Names) ((_righthandsideIunboundNames) :: Names) -> + _patternIunboundNames ++ _righthandsideIunboundNames + {-# INLINE rule636 #-} + rule636 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Declaration_PatternBinding _rangeIself _patternIself _righthandsideIself + {-# INLINE rule637 #-} + rule637 = \ _self -> + _self + {-# INLINE rule638 #-} + rule638 = \ ((_righthandsideIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _righthandsideIcollectScopeInfos + {-# INLINE rule639 #-} + rule639 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule640 #-} + rule640 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule641 #-} + rule641 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule642 #-} + rule642 = \ ((_righthandsideIcounter) :: Int) -> + _righthandsideIcounter + {-# INLINE rule643 #-} + rule643 = \ ((_righthandsideIkindErrors) :: [Error]) -> + _righthandsideIkindErrors + {-# INLINE rule644 #-} + rule644 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule645 #-} + rule645 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule646 #-} + rule646 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule647 #-} + rule647 = \ ((_righthandsideIwarnings) :: [Warning]) -> + _righthandsideIwarnings + {-# INLINE rule648 #-} + rule648 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule649 #-} + rule649 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule650 #-} + rule650 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule651 #-} + rule651 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule652 #-} + rule652 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule653 #-} + rule653 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule654 #-} + rule654 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule655 #-} + rule655 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule656 #-} + rule656 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule657 #-} + rule657 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule658 #-} + rule658 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule659 #-} + rule659 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule660 #-} + rule660 = \ ((_patternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternIcollectScopeInfos + {-# INLINE rule661 #-} + rule661 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule662 #-} + rule662 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule663 #-} + rule663 = \ ((_patternImiscerrors) :: [Error]) -> + _patternImiscerrors + {-# INLINE rule664 #-} + rule664 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule665 #-} + rule665 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule666 #-} + rule666 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule667 #-} + rule667 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule668 #-} + rule668 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule669 #-} + rule669 = \ ((_patternIwarnings) :: [Warning]) -> + _patternIwarnings +{-# NOINLINE sem_Declaration_TypeSignature #-} +sem_Declaration_TypeSignature :: T_Range -> T_Names -> T_Type -> T_Declaration +sem_Declaration_TypeSignature arg_range_ arg_names_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIcontextRange _typeImiscerrors _typeIself _typeItypevariables _typeIwarnings) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOallTypeConstructors _typeOmiscerrors _typeOoptions _typeOtypeConstructors _typeOwarnings) + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule670 _lhsItypeSignatures _namesIself _typeScheme + (_typeScheme,_intMap) = rule671 _typeIself + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule672 _lhsIkindErrors _newErrors + _newErrors = rule673 _lhsIallValueConstructors _lhsInamesInScope _lhsItypeConstructors _typeIself + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule674 () + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule675 _intMap _lhsIorderedTypeSynonyms _typeIcontextRange _typeIwarnings _typeScheme + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule676 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule677 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule678 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule679 () + _self = rule680 _namesIself _rangeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule681 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule682 _lhsIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule683 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule684 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule685 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule686 _lhsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule687 _typeImiscerrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule688 _lhsIoperatorFixities + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule689 _lhsIsuspiciousFBs + _typeOallTypeConstructors = rule690 _lhsIallTypeConstructors + _typeOmiscerrors = rule691 _lhsImiscerrors + _typeOoptions = rule692 _lhsIoptions + _typeOtypeConstructors = rule693 _lhsItypeConstructors + _typeOwarnings = rule694 _lhsIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule670 #-} + rule670 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) ((_namesIself) :: Names) _typeScheme -> + [ (name, _typeScheme) | name <- _namesIself ] ++ _lhsItypeSignatures + {-# INLINE rule671 #-} + rule671 = \ ((_typeIself) :: Type) -> + makeTpSchemeFromType' _typeIself + {-# INLINE rule672 #-} + rule672 = \ ((_lhsIkindErrors) :: [Error]) _newErrors -> + _newErrors ++ _lhsIkindErrors + {-# INLINE rule673 #-} + rule673 = \ ((_lhsIallValueConstructors) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsItypeConstructors) :: M.Map Name Int) ((_typeIself) :: Type) -> + checkType _lhsItypeConstructors (_lhsInamesInScope ++ _lhsIallValueConstructors) _typeIself + {-# INLINE rule674 #-} + rule674 = \ (_ :: ()) -> + Nothing + {-# INLINE rule675 #-} + rule675 = \ _intMap ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) ((_typeIcontextRange) :: Range) ((_typeIwarnings) :: [Warning]) _typeScheme -> + simplifyContext _lhsIorderedTypeSynonyms _typeIcontextRange _intMap _typeScheme ++ _typeIwarnings + {-# INLINE rule676 #-} + rule676 = \ (_ :: ()) -> + [] + {-# INLINE rule677 #-} + rule677 = \ (_ :: ()) -> + [] + {-# INLINE rule678 #-} + rule678 = \ (_ :: ()) -> + [] + {-# INLINE rule679 #-} + rule679 = \ (_ :: ()) -> + [] + {-# INLINE rule680 #-} + rule680 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Declaration_TypeSignature _rangeIself _namesIself _typeIself + {-# INLINE rule681 #-} + rule681 = \ _self -> + _self + {-# INLINE rule682 #-} + rule682 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule683 #-} + rule683 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule684 #-} + rule684 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule685 #-} + rule685 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule686 #-} + rule686 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule687 #-} + rule687 = \ ((_typeImiscerrors) :: [Error]) -> + _typeImiscerrors + {-# INLINE rule688 #-} + rule688 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule689 #-} + rule689 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule690 #-} + rule690 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule691 #-} + rule691 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule692 #-} + rule692 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule693 #-} + rule693 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule694 #-} + rule694 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Declaration_Fixity #-} +sem_Declaration_Fixity :: T_Range -> T_Fixity -> T_MaybeInt -> T_Names -> T_Declaration +sem_Declaration_Fixity arg_range_ arg_fixity_ arg_priority_ arg_operators_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fixityX53 = Control.Monad.Identity.runIdentity (attach_T_Fixity (arg_fixity_)) + _priorityX101 = Control.Monad.Identity.runIdentity (attach_T_MaybeInt (arg_priority_)) + _operatorsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_operators_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Fixity_vOut52 _fixityIself) = inv_Fixity_s53 _fixityX53 (T_Fixity_vIn52 ) + (T_MaybeInt_vOut100 _priorityIself) = inv_MaybeInt_s101 _priorityX101 (T_MaybeInt_vIn100 ) + (T_Names_vOut115 _operatorsIself) = inv_Names_s116 _operatorsX116 (T_Names_vIn115 ) + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule695 _fixityIself _lhsIoperatorFixities _operatorsIself _priorityIself + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule696 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule697 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule698 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule699 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule700 () + _self = rule701 _fixityIself _operatorsIself _priorityIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule702 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule703 _lhsIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule704 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule705 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule706 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule707 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule708 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule709 _lhsImiscerrors + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule710 _lhsIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule711 _lhsItypeSignatures + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule712 _lhsIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule695 #-} + rule695 = \ ((_fixityIself) :: Fixity) ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) ((_operatorsIself) :: Names) ((_priorityIself) :: MaybeInt) -> + let associativity = case _fixityIself of + Fixity_Infix _ -> AssocNone + Fixity_Infixl _ -> AssocLeft + Fixity_Infixr _ -> AssocRight + priority = case _priorityIself of + MaybeInt_Just i -> i + MaybeInt_Nothing -> 9 + in [ (name, (priority, associativity)) | name <- _operatorsIself ] ++ _lhsIoperatorFixities + {-# INLINE rule696 #-} + rule696 = \ (_ :: ()) -> + Nothing + {-# INLINE rule697 #-} + rule697 = \ (_ :: ()) -> + [] + {-# INLINE rule698 #-} + rule698 = \ (_ :: ()) -> + [] + {-# INLINE rule699 #-} + rule699 = \ (_ :: ()) -> + [] + {-# INLINE rule700 #-} + rule700 = \ (_ :: ()) -> + [] + {-# INLINE rule701 #-} + rule701 = \ ((_fixityIself) :: Fixity) ((_operatorsIself) :: Names) ((_priorityIself) :: MaybeInt) ((_rangeIself) :: Range) -> + Declaration_Fixity _rangeIself _fixityIself _priorityIself _operatorsIself + {-# INLINE rule702 #-} + rule702 = \ _self -> + _self + {-# INLINE rule703 #-} + rule703 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule704 #-} + rule704 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule705 #-} + rule705 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule706 #-} + rule706 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule707 #-} + rule707 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule708 #-} + rule708 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule709 #-} + rule709 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule710 #-} + rule710 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule711 #-} + rule711 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule712 #-} + rule712 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Declaration_Empty #-} +sem_Declaration_Empty :: T_Range -> T_Declaration +sem_Declaration_Empty arg_range_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule713 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule714 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule715 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule716 () + _self = rule717 _rangeIself + _lhsOself :: Declaration + _lhsOself = rule718 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule719 _lhsIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule720 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule721 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule722 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule723 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule724 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule725 _lhsImiscerrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule726 _lhsIoperatorFixities + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule727 _lhsIpreviousWasAlsoFB + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule728 _lhsIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule729 _lhsItypeSignatures + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule730 _lhsIwarnings + __result_ = T_Declaration_vOut28 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule713 #-} + rule713 = \ (_ :: ()) -> + [] + {-# INLINE rule714 #-} + rule714 = \ (_ :: ()) -> + [] + {-# INLINE rule715 #-} + rule715 = \ (_ :: ()) -> + [] + {-# INLINE rule716 #-} + rule716 = \ (_ :: ()) -> + [] + {-# INLINE rule717 #-} + rule717 = \ ((_rangeIself) :: Range) -> + Declaration_Empty _rangeIself + {-# INLINE rule718 #-} + rule718 = \ _self -> + _self + {-# INLINE rule719 #-} + rule719 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule720 #-} + rule720 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule721 #-} + rule721 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule722 #-} + rule722 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule723 #-} + rule723 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule724 #-} + rule724 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule725 #-} + rule725 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule726 #-} + rule726 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule727 #-} + rule727 = \ ((_lhsIpreviousWasAlsoFB) :: Maybe Name) -> + _lhsIpreviousWasAlsoFB + {-# INLINE rule728 #-} + rule728 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule729 #-} + rule729 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule730 #-} + rule730 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Declarations ------------------------------------------------ +-- wrapper +data Inh_Declarations = Inh_Declarations { allTypeConstructors_Inh_Declarations :: (Names), allValueConstructors_Inh_Declarations :: (Names), classEnvironment_Inh_Declarations :: (ClassEnvironment), collectScopeInfos_Inh_Declarations :: ([(ScopeInfo, Entity)]), collectTypeConstructors_Inh_Declarations :: ([(Name,Int)]), collectTypeSynonyms_Inh_Declarations :: ([(Name,(Int,Tps -> Tp))]), collectValueConstructors_Inh_Declarations :: ([(Name,TpScheme)]), counter_Inh_Declarations :: (Int), kindErrors_Inh_Declarations :: ([Error]), miscerrors_Inh_Declarations :: ([Error]), namesInScope_Inh_Declarations :: (Names), operatorFixities_Inh_Declarations :: ([(Name,(Int,Assoc))]), options_Inh_Declarations :: ([Option]), orderedTypeSynonyms_Inh_Declarations :: (OrderedTypeSynonyms), previousWasAlsoFB_Inh_Declarations :: (Maybe Name), suspiciousFBs_Inh_Declarations :: ([(Name,Name)]), typeConstructors_Inh_Declarations :: (M.Map Name Int), typeSignatures_Inh_Declarations :: ([(Name,TpScheme)]), valueConstructors_Inh_Declarations :: (M.Map Name TpScheme), warnings_Inh_Declarations :: ([Warning]) } +data Syn_Declarations = Syn_Declarations { collectInstances_Syn_Declarations :: ([(Name, Instance)]), collectScopeInfos_Syn_Declarations :: ([(ScopeInfo, Entity)]), collectTypeConstructors_Syn_Declarations :: ([(Name,Int)]), collectTypeSynonyms_Syn_Declarations :: ([(Name,(Int,Tps -> Tp))]), collectValueConstructors_Syn_Declarations :: ([(Name,TpScheme)]), counter_Syn_Declarations :: (Int), declVarNames_Syn_Declarations :: (Names), kindErrors_Syn_Declarations :: ([Error]), miscerrors_Syn_Declarations :: ([Error]), operatorFixities_Syn_Declarations :: ([(Name,(Int,Assoc))]), previousWasAlsoFB_Syn_Declarations :: (Maybe Name), restrictedNames_Syn_Declarations :: (Names), self_Syn_Declarations :: (Declarations), suspiciousFBs_Syn_Declarations :: ([(Name,Name)]), typeSignatures_Syn_Declarations :: ([(Name,TpScheme)]), unboundNames_Syn_Declarations :: (Names), warnings_Syn_Declarations :: ([Warning]) } +{-# INLINABLE wrap_Declarations #-} +wrap_Declarations :: T_Declarations -> Inh_Declarations -> (Syn_Declarations ) +wrap_Declarations (T_Declarations act) (Inh_Declarations _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declarations_vIn31 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings + (T_Declarations_vOut31 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings) <- return (inv_Declarations_s32 sem arg) + return (Syn_Declarations _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Declarations #-} +sem_Declarations :: Declarations -> T_Declarations +sem_Declarations list = Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list) + +-- semantic domain +newtype T_Declarations = T_Declarations { + attach_T_Declarations :: Identity (T_Declarations_s32 ) + } +newtype T_Declarations_s32 = C_Declarations_s32 { + inv_Declarations_s32 :: (T_Declarations_v31 ) + } +data T_Declarations_s33 = C_Declarations_s33 +type T_Declarations_v31 = (T_Declarations_vIn31 ) -> (T_Declarations_vOut31 ) +data T_Declarations_vIn31 = T_Declarations_vIn31 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) ([(Name,Int)]) ([(Name,(Int,Tps -> Tp))]) ([(Name,TpScheme)]) (Int) ([Error]) ([Error]) (Names) ([(Name,(Int,Assoc))]) ([Option]) (OrderedTypeSynonyms) (Maybe Name) ([(Name,Name)]) (M.Map Name Int) ([(Name,TpScheme)]) (M.Map Name TpScheme) ([Warning]) +data T_Declarations_vOut31 = T_Declarations_vOut31 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) ([(Name,Int)]) ([(Name,(Int,Tps -> Tp))]) ([(Name,TpScheme)]) (Int) (Names) ([Error]) ([Error]) ([(Name,(Int,Assoc))]) (Maybe Name) (Names) (Declarations) ([(Name,Name)]) ([(Name,TpScheme)]) (Names) ([Warning]) +{-# NOINLINE sem_Declarations_Cons #-} +sem_Declarations_Cons :: T_Declaration -> T_Declarations -> T_Declarations +sem_Declarations_Cons arg_hd_ arg_tl_ = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Declaration (arg_hd_)) + _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_tl_)) + (T_Declaration_vOut28 _hdIcollectInstances _hdIcollectScopeInfos _hdIcollectTypeConstructors _hdIcollectTypeSynonyms _hdIcollectValueConstructors _hdIcounter _hdIdeclVarNames _hdIkindErrors _hdImiscerrors _hdIoperatorFixities _hdIpreviousWasAlsoFB _hdIrestrictedNames _hdIself _hdIsuspiciousFBs _hdItypeSignatures _hdIunboundNames _hdIwarnings) = inv_Declaration_s29 _hdX29 (T_Declaration_vIn28 _hdOallTypeConstructors _hdOallValueConstructors _hdOclassEnvironment _hdOcollectScopeInfos _hdOcollectTypeConstructors _hdOcollectTypeSynonyms _hdOcollectValueConstructors _hdOcounter _hdOkindErrors _hdOmiscerrors _hdOnamesInScope _hdOoperatorFixities _hdOoptions _hdOorderedTypeSynonyms _hdOpreviousWasAlsoFB _hdOsuspiciousFBs _hdOtypeConstructors _hdOtypeSignatures _hdOvalueConstructors _hdOwarnings) + (T_Declarations_vOut31 _tlIcollectInstances _tlIcollectScopeInfos _tlIcollectTypeConstructors _tlIcollectTypeSynonyms _tlIcollectValueConstructors _tlIcounter _tlIdeclVarNames _tlIkindErrors _tlImiscerrors _tlIoperatorFixities _tlIpreviousWasAlsoFB _tlIrestrictedNames _tlIself _tlIsuspiciousFBs _tlItypeSignatures _tlIunboundNames _tlIwarnings) = inv_Declarations_s32 _tlX32 (T_Declarations_vIn31 _tlOallTypeConstructors _tlOallValueConstructors _tlOclassEnvironment _tlOcollectScopeInfos _tlOcollectTypeConstructors _tlOcollectTypeSynonyms _tlOcollectValueConstructors _tlOcounter _tlOkindErrors _tlOmiscerrors _tlOnamesInScope _tlOoperatorFixities _tlOoptions _tlOorderedTypeSynonyms _tlOpreviousWasAlsoFB _tlOsuspiciousFBs _tlOtypeConstructors _tlOtypeSignatures _tlOvalueConstructors _tlOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule731 _hdIcollectInstances _tlIcollectInstances + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule732 _hdIdeclVarNames _tlIdeclVarNames + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule733 _hdIrestrictedNames _tlIrestrictedNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule734 _hdIunboundNames _tlIunboundNames + _self = rule735 _hdIself _tlIself + _lhsOself :: Declarations + _lhsOself = rule736 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule737 _tlIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule738 _tlIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule739 _tlIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule740 _tlIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule741 _tlIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule742 _tlIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule743 _tlImiscerrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule744 _tlIoperatorFixities + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule745 _tlIpreviousWasAlsoFB + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule746 _tlIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule747 _tlItypeSignatures + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule748 _tlIwarnings + _hdOallTypeConstructors = rule749 _lhsIallTypeConstructors + _hdOallValueConstructors = rule750 _lhsIallValueConstructors + _hdOclassEnvironment = rule751 _lhsIclassEnvironment + _hdOcollectScopeInfos = rule752 _lhsIcollectScopeInfos + _hdOcollectTypeConstructors = rule753 _lhsIcollectTypeConstructors + _hdOcollectTypeSynonyms = rule754 _lhsIcollectTypeSynonyms + _hdOcollectValueConstructors = rule755 _lhsIcollectValueConstructors + _hdOcounter = rule756 _lhsIcounter + _hdOkindErrors = rule757 _lhsIkindErrors + _hdOmiscerrors = rule758 _lhsImiscerrors + _hdOnamesInScope = rule759 _lhsInamesInScope + _hdOoperatorFixities = rule760 _lhsIoperatorFixities + _hdOoptions = rule761 _lhsIoptions + _hdOorderedTypeSynonyms = rule762 _lhsIorderedTypeSynonyms + _hdOpreviousWasAlsoFB = rule763 _lhsIpreviousWasAlsoFB + _hdOsuspiciousFBs = rule764 _lhsIsuspiciousFBs + _hdOtypeConstructors = rule765 _lhsItypeConstructors + _hdOtypeSignatures = rule766 _lhsItypeSignatures + _hdOvalueConstructors = rule767 _lhsIvalueConstructors + _hdOwarnings = rule768 _lhsIwarnings + _tlOallTypeConstructors = rule769 _lhsIallTypeConstructors + _tlOallValueConstructors = rule770 _lhsIallValueConstructors + _tlOclassEnvironment = rule771 _lhsIclassEnvironment + _tlOcollectScopeInfos = rule772 _hdIcollectScopeInfos + _tlOcollectTypeConstructors = rule773 _hdIcollectTypeConstructors + _tlOcollectTypeSynonyms = rule774 _hdIcollectTypeSynonyms + _tlOcollectValueConstructors = rule775 _hdIcollectValueConstructors + _tlOcounter = rule776 _hdIcounter + _tlOkindErrors = rule777 _hdIkindErrors + _tlOmiscerrors = rule778 _hdImiscerrors + _tlOnamesInScope = rule779 _lhsInamesInScope + _tlOoperatorFixities = rule780 _hdIoperatorFixities + _tlOoptions = rule781 _lhsIoptions + _tlOorderedTypeSynonyms = rule782 _lhsIorderedTypeSynonyms + _tlOpreviousWasAlsoFB = rule783 _hdIpreviousWasAlsoFB + _tlOsuspiciousFBs = rule784 _hdIsuspiciousFBs + _tlOtypeConstructors = rule785 _lhsItypeConstructors + _tlOtypeSignatures = rule786 _hdItypeSignatures + _tlOvalueConstructors = rule787 _lhsIvalueConstructors + _tlOwarnings = rule788 _hdIwarnings + __result_ = T_Declarations_vOut31 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule731 #-} + rule731 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule732 #-} + rule732 = \ ((_hdIdeclVarNames) :: Names) ((_tlIdeclVarNames) :: Names) -> + _hdIdeclVarNames ++ _tlIdeclVarNames + {-# INLINE rule733 #-} + rule733 = \ ((_hdIrestrictedNames) :: Names) ((_tlIrestrictedNames) :: Names) -> + _hdIrestrictedNames ++ _tlIrestrictedNames + {-# INLINE rule734 #-} + rule734 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule735 #-} + rule735 = \ ((_hdIself) :: Declaration) ((_tlIself) :: Declarations) -> + (:) _hdIself _tlIself + {-# INLINE rule736 #-} + rule736 = \ _self -> + _self + {-# INLINE rule737 #-} + rule737 = \ ((_tlIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _tlIcollectScopeInfos + {-# INLINE rule738 #-} + rule738 = \ ((_tlIcollectTypeConstructors) :: [(Name,Int)]) -> + _tlIcollectTypeConstructors + {-# INLINE rule739 #-} + rule739 = \ ((_tlIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _tlIcollectTypeSynonyms + {-# INLINE rule740 #-} + rule740 = \ ((_tlIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _tlIcollectValueConstructors + {-# INLINE rule741 #-} + rule741 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule742 #-} + rule742 = \ ((_tlIkindErrors) :: [Error]) -> + _tlIkindErrors + {-# INLINE rule743 #-} + rule743 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule744 #-} + rule744 = \ ((_tlIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _tlIoperatorFixities + {-# INLINE rule745 #-} + rule745 = \ ((_tlIpreviousWasAlsoFB) :: Maybe Name) -> + _tlIpreviousWasAlsoFB + {-# INLINE rule746 #-} + rule746 = \ ((_tlIsuspiciousFBs) :: [(Name,Name)]) -> + _tlIsuspiciousFBs + {-# INLINE rule747 #-} + rule747 = \ ((_tlItypeSignatures) :: [(Name,TpScheme)]) -> + _tlItypeSignatures + {-# INLINE rule748 #-} + rule748 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule749 #-} + rule749 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule750 #-} + rule750 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule751 #-} + rule751 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule752 #-} + rule752 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule753 #-} + rule753 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule754 #-} + rule754 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule755 #-} + rule755 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule756 #-} + rule756 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule757 #-} + rule757 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule758 #-} + rule758 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule759 #-} + rule759 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule760 #-} + rule760 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule761 #-} + rule761 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule762 #-} + rule762 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule763 #-} + rule763 = \ ((_lhsIpreviousWasAlsoFB) :: Maybe Name) -> + _lhsIpreviousWasAlsoFB + {-# INLINE rule764 #-} + rule764 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule765 #-} + rule765 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule766 #-} + rule766 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule767 #-} + rule767 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule768 #-} + rule768 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule769 #-} + rule769 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule770 #-} + rule770 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule771 #-} + rule771 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule772 #-} + rule772 = \ ((_hdIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _hdIcollectScopeInfos + {-# INLINE rule773 #-} + rule773 = \ ((_hdIcollectTypeConstructors) :: [(Name,Int)]) -> + _hdIcollectTypeConstructors + {-# INLINE rule774 #-} + rule774 = \ ((_hdIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _hdIcollectTypeSynonyms + {-# INLINE rule775 #-} + rule775 = \ ((_hdIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _hdIcollectValueConstructors + {-# INLINE rule776 #-} + rule776 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule777 #-} + rule777 = \ ((_hdIkindErrors) :: [Error]) -> + _hdIkindErrors + {-# INLINE rule778 #-} + rule778 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule779 #-} + rule779 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule780 #-} + rule780 = \ ((_hdIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _hdIoperatorFixities + {-# INLINE rule781 #-} + rule781 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule782 #-} + rule782 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule783 #-} + rule783 = \ ((_hdIpreviousWasAlsoFB) :: Maybe Name) -> + _hdIpreviousWasAlsoFB + {-# INLINE rule784 #-} + rule784 = \ ((_hdIsuspiciousFBs) :: [(Name,Name)]) -> + _hdIsuspiciousFBs + {-# INLINE rule785 #-} + rule785 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule786 #-} + rule786 = \ ((_hdItypeSignatures) :: [(Name,TpScheme)]) -> + _hdItypeSignatures + {-# INLINE rule787 #-} + rule787 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule788 #-} + rule788 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_Declarations_Nil #-} +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcollectTypeConstructors _lhsIcollectTypeSynonyms _lhsIcollectValueConstructors _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoperatorFixities _lhsIoptions _lhsIorderedTypeSynonyms _lhsIpreviousWasAlsoFB _lhsIsuspiciousFBs _lhsItypeConstructors _lhsItypeSignatures _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule789 () + _lhsOdeclVarNames :: Names + _lhsOdeclVarNames = rule790 () + _lhsOrestrictedNames :: Names + _lhsOrestrictedNames = rule791 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule792 () + _self = rule793 () + _lhsOself :: Declarations + _lhsOself = rule794 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule795 _lhsIcollectScopeInfos + _lhsOcollectTypeConstructors :: [(Name,Int)] + _lhsOcollectTypeConstructors = rule796 _lhsIcollectTypeConstructors + _lhsOcollectTypeSynonyms :: [(Name,(Int,Tps -> Tp))] + _lhsOcollectTypeSynonyms = rule797 _lhsIcollectTypeSynonyms + _lhsOcollectValueConstructors :: [(Name,TpScheme)] + _lhsOcollectValueConstructors = rule798 _lhsIcollectValueConstructors + _lhsOcounter :: Int + _lhsOcounter = rule799 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule800 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule801 _lhsImiscerrors + _lhsOoperatorFixities :: [(Name,(Int,Assoc))] + _lhsOoperatorFixities = rule802 _lhsIoperatorFixities + _lhsOpreviousWasAlsoFB :: Maybe Name + _lhsOpreviousWasAlsoFB = rule803 _lhsIpreviousWasAlsoFB + _lhsOsuspiciousFBs :: [(Name,Name)] + _lhsOsuspiciousFBs = rule804 _lhsIsuspiciousFBs + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule805 _lhsItypeSignatures + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule806 _lhsIwarnings + __result_ = T_Declarations_vOut31 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcollectTypeConstructors _lhsOcollectTypeSynonyms _lhsOcollectValueConstructors _lhsOcounter _lhsOdeclVarNames _lhsOkindErrors _lhsOmiscerrors _lhsOoperatorFixities _lhsOpreviousWasAlsoFB _lhsOrestrictedNames _lhsOself _lhsOsuspiciousFBs _lhsOtypeSignatures _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule789 #-} + rule789 = \ (_ :: ()) -> + [] + {-# INLINE rule790 #-} + rule790 = \ (_ :: ()) -> + [] + {-# INLINE rule791 #-} + rule791 = \ (_ :: ()) -> + [] + {-# INLINE rule792 #-} + rule792 = \ (_ :: ()) -> + [] + {-# INLINE rule793 #-} + rule793 = \ (_ :: ()) -> + [] + {-# INLINE rule794 #-} + rule794 = \ _self -> + _self + {-# INLINE rule795 #-} + rule795 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule796 #-} + rule796 = \ ((_lhsIcollectTypeConstructors) :: [(Name,Int)]) -> + _lhsIcollectTypeConstructors + {-# INLINE rule797 #-} + rule797 = \ ((_lhsIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + _lhsIcollectTypeSynonyms + {-# INLINE rule798 #-} + rule798 = \ ((_lhsIcollectValueConstructors) :: [(Name,TpScheme)]) -> + _lhsIcollectValueConstructors + {-# INLINE rule799 #-} + rule799 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule800 #-} + rule800 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule801 #-} + rule801 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule802 #-} + rule802 = \ ((_lhsIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + _lhsIoperatorFixities + {-# INLINE rule803 #-} + rule803 = \ ((_lhsIpreviousWasAlsoFB) :: Maybe Name) -> + _lhsIpreviousWasAlsoFB + {-# INLINE rule804 #-} + rule804 = \ ((_lhsIsuspiciousFBs) :: [(Name,Name)]) -> + _lhsIsuspiciousFBs + {-# INLINE rule805 #-} + rule805 = \ ((_lhsItypeSignatures) :: [(Name,TpScheme)]) -> + _lhsItypeSignatures + {-# INLINE rule806 #-} + rule806 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Export ------------------------------------------------------ +-- wrapper +data Inh_Export = Inh_Export { consInScope_Inh_Export :: (Names), modulesInScope_Inh_Export :: (Names), namesInScop_Inh_Export :: (Names), tyconsInScope_Inh_Export :: (Names) } +data Syn_Export = Syn_Export { exportErrors_Syn_Export :: ([Error]), self_Syn_Export :: (Export) } +{-# INLINABLE wrap_Export #-} +wrap_Export :: T_Export -> Inh_Export -> (Syn_Export ) +wrap_Export (T_Export act) (Inh_Export _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Export_vIn34 _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope + (T_Export_vOut34 _lhsOexportErrors _lhsOself) <- return (inv_Export_s35 sem arg) + return (Syn_Export _lhsOexportErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Export #-} +sem_Export :: Export -> T_Export +sem_Export ( Export_Variable range_ name_ ) = sem_Export_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_TypeOrClass range_ name_ names_ ) = sem_Export_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Export ( Export_TypeOrClassComplete range_ name_ ) = sem_Export_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_Module range_ name_ ) = sem_Export_Module ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Export = T_Export { + attach_T_Export :: Identity (T_Export_s35 ) + } +newtype T_Export_s35 = C_Export_s35 { + inv_Export_s35 :: (T_Export_v34 ) + } +data T_Export_s36 = C_Export_s36 +type T_Export_v34 = (T_Export_vIn34 ) -> (T_Export_vOut34 ) +data T_Export_vIn34 = T_Export_vIn34 (Names) (Names) (Names) (Names) +data T_Export_vOut34 = T_Export_vOut34 ([Error]) (Export) +{-# NOINLINE sem_Export_Variable #-} +sem_Export_Variable :: T_Range -> T_Name -> T_Export +sem_Export_Variable arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOexportErrors :: [Error] + _lhsOexportErrors = rule807 _lhsInamesInScop _nameIself + _self = rule808 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule809 _self + __result_ = T_Export_vOut34 _lhsOexportErrors _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule807 #-} + rule807 = \ ((_lhsInamesInScop) :: Names) ((_nameIself) :: Name) -> + checkExport ExportVariable _nameIself + _lhsInamesInScop + {-# INLINE rule808 #-} + rule808 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Variable _rangeIself _nameIself + {-# INLINE rule809 #-} + rule809 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClass #-} +sem_Export_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Export +sem_Export_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _lhsOexportErrors :: [Error] + _lhsOexportErrors = rule810 () + _self = rule811 _nameIself _namesIself _rangeIself + _lhsOself :: Export + _lhsOself = rule812 _self + __result_ = T_Export_vOut34 _lhsOexportErrors _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule810 #-} + rule810 = \ (_ :: ()) -> + [] + {-# INLINE rule811 #-} + rule811 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Export_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule812 #-} + rule812 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClassComplete #-} +sem_Export_TypeOrClassComplete :: T_Range -> T_Name -> T_Export +sem_Export_TypeOrClassComplete arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOexportErrors :: [Error] + _lhsOexportErrors = rule813 () + _self = rule814 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule815 _self + __result_ = T_Export_vOut34 _lhsOexportErrors _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule813 #-} + rule813 = \ (_ :: ()) -> + [] + {-# INLINE rule814 #-} + rule814 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule815 #-} + rule815 = \ _self -> + _self +{-# NOINLINE sem_Export_Module #-} +sem_Export_Module :: T_Range -> T_Name -> T_Export +sem_Export_Module arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOexportErrors :: [Error] + _lhsOexportErrors = rule816 _lhsImodulesInScope _nameIself + _self = rule817 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule818 _self + __result_ = T_Export_vOut34 _lhsOexportErrors _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule816 #-} + rule816 = \ ((_lhsImodulesInScope) :: Names) ((_nameIself) :: Name) -> + checkExport ExportModule _nameIself + _lhsImodulesInScope + {-# INLINE rule817 #-} + rule817 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Module _rangeIself _nameIself + {-# INLINE rule818 #-} + rule818 = \ _self -> + _self + +-- Exports ----------------------------------------------------- +-- wrapper +data Inh_Exports = Inh_Exports { consInScope_Inh_Exports :: (Names), modulesInScope_Inh_Exports :: (Names), namesInScop_Inh_Exports :: (Names), tyconsInScope_Inh_Exports :: (Names) } +data Syn_Exports = Syn_Exports { exportErrors_Syn_Exports :: ([Error]), self_Syn_Exports :: (Exports) } +{-# INLINABLE wrap_Exports #-} +wrap_Exports :: T_Exports -> Inh_Exports -> (Syn_Exports ) +wrap_Exports (T_Exports act) (Inh_Exports _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Exports_vIn37 _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope + (T_Exports_vOut37 _lhsOexportErrors _lhsOself) <- return (inv_Exports_s38 sem arg) + return (Syn_Exports _lhsOexportErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Exports #-} +sem_Exports :: Exports -> T_Exports +sem_Exports list = Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list) + +-- semantic domain +newtype T_Exports = T_Exports { + attach_T_Exports :: Identity (T_Exports_s38 ) + } +newtype T_Exports_s38 = C_Exports_s38 { + inv_Exports_s38 :: (T_Exports_v37 ) + } +data T_Exports_s39 = C_Exports_s39 +type T_Exports_v37 = (T_Exports_vIn37 ) -> (T_Exports_vOut37 ) +data T_Exports_vIn37 = T_Exports_vIn37 (Names) (Names) (Names) (Names) +data T_Exports_vOut37 = T_Exports_vOut37 ([Error]) (Exports) +{-# NOINLINE sem_Exports_Cons #-} +sem_Exports_Cons :: T_Export -> T_Exports -> T_Exports +sem_Exports_Cons arg_hd_ arg_tl_ = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope) -> ( let + _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Export (arg_hd_)) + _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_tl_)) + (T_Export_vOut34 _hdIexportErrors _hdIself) = inv_Export_s35 _hdX35 (T_Export_vIn34 _hdOconsInScope _hdOmodulesInScope _hdOnamesInScop _hdOtyconsInScope) + (T_Exports_vOut37 _tlIexportErrors _tlIself) = inv_Exports_s38 _tlX38 (T_Exports_vIn37 _tlOconsInScope _tlOmodulesInScope _tlOnamesInScop _tlOtyconsInScope) + _lhsOexportErrors :: [Error] + _lhsOexportErrors = rule819 _hdIexportErrors _tlIexportErrors + _self = rule820 _hdIself _tlIself + _lhsOself :: Exports + _lhsOself = rule821 _self + _hdOconsInScope = rule822 _lhsIconsInScope + _hdOmodulesInScope = rule823 _lhsImodulesInScope + _hdOnamesInScop = rule824 _lhsInamesInScop + _hdOtyconsInScope = rule825 _lhsItyconsInScope + _tlOconsInScope = rule826 _lhsIconsInScope + _tlOmodulesInScope = rule827 _lhsImodulesInScope + _tlOnamesInScop = rule828 _lhsInamesInScop + _tlOtyconsInScope = rule829 _lhsItyconsInScope + __result_ = T_Exports_vOut37 _lhsOexportErrors _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule819 #-} + rule819 = \ ((_hdIexportErrors) :: [Error]) ((_tlIexportErrors) :: [Error]) -> + _hdIexportErrors ++ _tlIexportErrors + {-# INLINE rule820 #-} + rule820 = \ ((_hdIself) :: Export) ((_tlIself) :: Exports) -> + (:) _hdIself _tlIself + {-# INLINE rule821 #-} + rule821 = \ _self -> + _self + {-# INLINE rule822 #-} + rule822 = \ ((_lhsIconsInScope) :: Names) -> + _lhsIconsInScope + {-# INLINE rule823 #-} + rule823 = \ ((_lhsImodulesInScope) :: Names) -> + _lhsImodulesInScope + {-# INLINE rule824 #-} + rule824 = \ ((_lhsInamesInScop) :: Names) -> + _lhsInamesInScop + {-# INLINE rule825 #-} + rule825 = \ ((_lhsItyconsInScope) :: Names) -> + _lhsItyconsInScope + {-# INLINE rule826 #-} + rule826 = \ ((_lhsIconsInScope) :: Names) -> + _lhsIconsInScope + {-# INLINE rule827 #-} + rule827 = \ ((_lhsImodulesInScope) :: Names) -> + _lhsImodulesInScope + {-# INLINE rule828 #-} + rule828 = \ ((_lhsInamesInScop) :: Names) -> + _lhsInamesInScop + {-# INLINE rule829 #-} + rule829 = \ ((_lhsItyconsInScope) :: Names) -> + _lhsItyconsInScope +{-# NOINLINE sem_Exports_Nil #-} +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope) -> ( let + _lhsOexportErrors :: [Error] + _lhsOexportErrors = rule830 () + _self = rule831 () + _lhsOself :: Exports + _lhsOself = rule832 _self + __result_ = T_Exports_vOut37 _lhsOexportErrors _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule830 #-} + rule830 = \ (_ :: ()) -> + [] + {-# INLINE rule831 #-} + rule831 = \ (_ :: ()) -> + [] + {-# INLINE rule832 #-} + rule832 = \ _self -> + _self + +-- Expression -------------------------------------------------- +-- wrapper +data Inh_Expression = Inh_Expression { allTypeConstructors_Inh_Expression :: (Names), allValueConstructors_Inh_Expression :: (Names), classEnvironment_Inh_Expression :: (ClassEnvironment), collectScopeInfos_Inh_Expression :: ([(ScopeInfo, Entity)]), counter_Inh_Expression :: (Int), kindErrors_Inh_Expression :: ([Error]), miscerrors_Inh_Expression :: ([Error]), namesInScope_Inh_Expression :: (Names), options_Inh_Expression :: ([Option]), orderedTypeSynonyms_Inh_Expression :: (OrderedTypeSynonyms), typeConstructors_Inh_Expression :: (M.Map Name Int), valueConstructors_Inh_Expression :: (M.Map Name TpScheme), warnings_Inh_Expression :: ([Warning]) } +data Syn_Expression = Syn_Expression { collectInstances_Syn_Expression :: ([(Name, Instance)]), collectScopeInfos_Syn_Expression :: ([(ScopeInfo, Entity)]), counter_Syn_Expression :: (Int), kindErrors_Syn_Expression :: ([Error]), miscerrors_Syn_Expression :: ([Error]), self_Syn_Expression :: (Expression), unboundNames_Syn_Expression :: (Names), warnings_Syn_Expression :: ([Warning]) } +{-# INLINABLE wrap_Expression #-} +wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) +wrap_Expression (T_Expression act) (Inh_Expression _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_Expression_s41 sem arg) + return (Syn_Expression _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Expression #-} +sem_Expression :: Expression -> T_Expression +sem_Expression ( Expression_Hole range_ id_ ) = sem_Expression_Hole ( sem_Range range_ ) id_ +sem_Expression ( Expression_Feedback range_ feedback_ expression_ ) = sem_Expression_Feedback ( sem_Range range_ ) feedback_ ( sem_Expression expression_ ) +sem_Expression ( Expression_MustUse range_ expression_ ) = sem_Expression_MustUse ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Literal range_ literal_ ) = sem_Expression_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Expression ( Expression_Variable range_ name_ ) = sem_Expression_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Constructor range_ name_ ) = sem_Expression_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Parenthesized range_ expression_ ) = sem_Expression_Parenthesized ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NormalApplication range_ function_ arguments_ ) = sem_Expression_NormalApplication ( sem_Range range_ ) ( sem_Expression function_ ) ( sem_Expressions arguments_ ) +sem_Expression ( Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ ) = sem_Expression_InfixApplication ( sem_Range range_ ) ( sem_MaybeExpression leftExpression_ ) ( sem_Expression operator_ ) ( sem_MaybeExpression rightExpression_ ) +sem_Expression ( Expression_If range_ guardExpression_ thenExpression_ elseExpression_ ) = sem_Expression_If ( sem_Range range_ ) ( sem_Expression guardExpression_ ) ( sem_Expression thenExpression_ ) ( sem_Expression elseExpression_ ) +sem_Expression ( Expression_Lambda range_ patterns_ expression_ ) = sem_Expression_Lambda ( sem_Range range_ ) ( sem_Patterns patterns_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Case range_ expression_ alternatives_ ) = sem_Expression_Case ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Alternatives alternatives_ ) +sem_Expression ( Expression_Let range_ declarations_ expression_ ) = sem_Expression_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Do range_ statements_ ) = sem_Expression_Do ( sem_Range range_ ) ( sem_Statements statements_ ) +sem_Expression ( Expression_List range_ expressions_ ) = sem_Expression_List ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Tuple range_ expressions_ ) = sem_Expression_Tuple ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Comprehension range_ expression_ qualifiers_ ) = sem_Expression_Comprehension ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Qualifiers qualifiers_ ) +sem_Expression ( Expression_Typed range_ expression_ type_ ) = sem_Expression_Typed ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Type type_ ) +sem_Expression ( Expression_RecordConstruction range_ name_ recordExpressionBindings_ ) = sem_Expression_RecordConstruction ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_RecordUpdate range_ expression_ recordExpressionBindings_ ) = sem_Expression_RecordUpdate ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_Enum range_ from_ then_ to_ ) = sem_Expression_Enum ( sem_Range range_ ) ( sem_Expression from_ ) ( sem_MaybeExpression then_ ) ( sem_MaybeExpression to_ ) +sem_Expression ( Expression_Negate range_ expression_ ) = sem_Expression_Negate ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NegateFloat range_ expression_ ) = sem_Expression_NegateFloat ( sem_Range range_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_Expression = T_Expression { + attach_T_Expression :: Identity (T_Expression_s41 ) + } +newtype T_Expression_s41 = C_Expression_s41 { + inv_Expression_s41 :: (T_Expression_v40 ) + } +data T_Expression_s42 = C_Expression_s42 +type T_Expression_v40 = (T_Expression_vIn40 ) -> (T_Expression_vOut40 ) +data T_Expression_vIn40 = T_Expression_vIn40 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_Expression_vOut40 = T_Expression_vOut40 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Expression) (Names) ([Warning]) +{-# NOINLINE sem_Expression_Hole #-} +sem_Expression_Hole :: T_Range -> (Integer) -> T_Expression +sem_Expression_Hole arg_range_ arg_id_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule833 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule834 () + _self = rule835 _rangeIself arg_id_ + _lhsOself :: Expression + _lhsOself = rule836 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule837 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule838 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule839 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule840 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule841 _lhsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule833 #-} + rule833 = \ (_ :: ()) -> + [] + {-# INLINE rule834 #-} + rule834 = \ (_ :: ()) -> + [] + {-# INLINE rule835 #-} + rule835 = \ ((_rangeIself) :: Range) id_ -> + Expression_Hole _rangeIself id_ + {-# INLINE rule836 #-} + rule836 = \ _self -> + _self + {-# INLINE rule837 #-} + rule837 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule838 #-} + rule838 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule839 #-} + rule839 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule840 #-} + rule840 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule841 #-} + rule841 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Expression_Feedback #-} +sem_Expression_Feedback :: T_Range -> (String) -> T_Expression -> T_Expression +sem_Expression_Feedback arg_range_ arg_feedback_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule842 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule843 _expressionIunboundNames + _self = rule844 _expressionIself _rangeIself arg_feedback_ + _lhsOself :: Expression + _lhsOself = rule845 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule846 _expressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule847 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule848 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule849 _expressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule850 _expressionIwarnings + _expressionOallTypeConstructors = rule851 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule852 _lhsIallValueConstructors + _expressionOclassEnvironment = rule853 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule854 _lhsIcollectScopeInfos + _expressionOcounter = rule855 _lhsIcounter + _expressionOkindErrors = rule856 _lhsIkindErrors + _expressionOmiscerrors = rule857 _lhsImiscerrors + _expressionOnamesInScope = rule858 _lhsInamesInScope + _expressionOoptions = rule859 _lhsIoptions + _expressionOorderedTypeSynonyms = rule860 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule861 _lhsItypeConstructors + _expressionOvalueConstructors = rule862 _lhsIvalueConstructors + _expressionOwarnings = rule863 _lhsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule842 #-} + rule842 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule843 #-} + rule843 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule844 #-} + rule844 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) feedback_ -> + Expression_Feedback _rangeIself feedback_ _expressionIself + {-# INLINE rule845 #-} + rule845 = \ _self -> + _self + {-# INLINE rule846 #-} + rule846 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule847 #-} + rule847 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule848 #-} + rule848 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule849 #-} + rule849 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule850 #-} + rule850 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule851 #-} + rule851 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule852 #-} + rule852 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule853 #-} + rule853 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule854 #-} + rule854 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule855 #-} + rule855 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule856 #-} + rule856 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule857 #-} + rule857 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule858 #-} + rule858 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule859 #-} + rule859 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule860 #-} + rule860 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule861 #-} + rule861 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule862 #-} + rule862 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule863 #-} + rule863 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Expression_MustUse #-} +sem_Expression_MustUse :: T_Range -> T_Expression -> T_Expression +sem_Expression_MustUse arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule864 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule865 _expressionIunboundNames + _self = rule866 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule867 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule868 _expressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule869 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule870 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule871 _expressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule872 _expressionIwarnings + _expressionOallTypeConstructors = rule873 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule874 _lhsIallValueConstructors + _expressionOclassEnvironment = rule875 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule876 _lhsIcollectScopeInfos + _expressionOcounter = rule877 _lhsIcounter + _expressionOkindErrors = rule878 _lhsIkindErrors + _expressionOmiscerrors = rule879 _lhsImiscerrors + _expressionOnamesInScope = rule880 _lhsInamesInScope + _expressionOoptions = rule881 _lhsIoptions + _expressionOorderedTypeSynonyms = rule882 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule883 _lhsItypeConstructors + _expressionOvalueConstructors = rule884 _lhsIvalueConstructors + _expressionOwarnings = rule885 _lhsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule864 #-} + rule864 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule865 #-} + rule865 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule866 #-} + rule866 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_MustUse _rangeIself _expressionIself + {-# INLINE rule867 #-} + rule867 = \ _self -> + _self + {-# INLINE rule868 #-} + rule868 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule869 #-} + rule869 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule870 #-} + rule870 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule871 #-} + rule871 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule872 #-} + rule872 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule873 #-} + rule873 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule874 #-} + rule874 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule875 #-} + rule875 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule876 #-} + rule876 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule877 #-} + rule877 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule878 #-} + rule878 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule879 #-} + rule879 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule880 #-} + rule880 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule881 #-} + rule881 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule882 #-} + rule882 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule883 #-} + rule883 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule884 #-} + rule884 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule885 #-} + rule885 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Expression_Literal #-} +sem_Expression_Literal :: T_Range -> T_Literal -> T_Expression +sem_Expression_Literal arg_range_ arg_literal_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIcollectScopeInfos _literalImiscerrors _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 _literalOcollectScopeInfos _literalOmiscerrors) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule886 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule887 () + _self = rule888 _literalIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule889 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule890 _literalIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule891 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule892 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule893 _literalImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule894 _lhsIwarnings + _literalOcollectScopeInfos = rule895 _lhsIcollectScopeInfos + _literalOmiscerrors = rule896 _lhsImiscerrors + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule886 #-} + rule886 = \ (_ :: ()) -> + [] + {-# INLINE rule887 #-} + rule887 = \ (_ :: ()) -> + [] + {-# INLINE rule888 #-} + rule888 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Expression_Literal _rangeIself _literalIself + {-# INLINE rule889 #-} + rule889 = \ _self -> + _self + {-# INLINE rule890 #-} + rule890 = \ ((_literalIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _literalIcollectScopeInfos + {-# INLINE rule891 #-} + rule891 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule892 #-} + rule892 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule893 #-} + rule893 = \ ((_literalImiscerrors) :: [Error]) -> + _literalImiscerrors + {-# INLINE rule894 #-} + rule894 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule895 #-} + rule895 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule896 #-} + rule896 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors +{-# NOINLINE sem_Expression_Variable #-} +sem_Expression_Variable :: T_Range -> T_Name -> T_Expression +sem_Expression_Variable arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule897 _nameIself + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule898 _lhsImiscerrors _undefinedErrors + _undefinedErrors = rule899 _lhsInamesInScope _nameIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule900 () + _self = rule901 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule902 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule903 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule904 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule905 _lhsIkindErrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule906 _lhsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule897 #-} + rule897 = \ ((_nameIself) :: Name) -> + [ _nameIself ] + {-# INLINE rule898 #-} + rule898 = \ ((_lhsImiscerrors) :: [Error]) _undefinedErrors -> + _undefinedErrors ++ _lhsImiscerrors + {-# INLINE rule899 #-} + rule899 = \ ((_lhsInamesInScope) :: Names) ((_nameIself) :: Name) -> + if _nameIself `elem` _lhsInamesInScope + then [] + else [ Undefined Variable _nameIself _lhsInamesInScope [] ] + {-# INLINE rule900 #-} + rule900 = \ (_ :: ()) -> + [] + {-# INLINE rule901 #-} + rule901 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Variable _rangeIself _nameIself + {-# INLINE rule902 #-} + rule902 = \ _self -> + _self + {-# INLINE rule903 #-} + rule903 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule904 #-} + rule904 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule905 #-} + rule905 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule906 #-} + rule906 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Expression_Constructor #-} +sem_Expression_Constructor :: T_Range -> T_Name -> T_Expression +sem_Expression_Constructor arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule907 _lhsImiscerrors _undefinedConstructorErrors + _undefinedConstructorErrors = rule908 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsInamesInScope _lhsIvalueConstructors _nameIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule909 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule910 () + _self = rule911 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule912 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule913 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule914 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule915 _lhsIkindErrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule916 _lhsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule907 #-} + rule907 = \ ((_lhsImiscerrors) :: [Error]) _undefinedConstructorErrors -> + _undefinedConstructorErrors ++ _lhsImiscerrors + {-# INLINE rule908 #-} + rule908 = \ ((_lhsIallTypeConstructors) :: Names) ((_lhsIallValueConstructors) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsIvalueConstructors) :: M.Map Name TpScheme) ((_nameIself) :: Name) -> + case M.lookup _nameIself _lhsIvalueConstructors of + Nothing -> [ undefinedConstructorInExpr _nameIself (_lhsInamesInScope ++ _lhsIallValueConstructors) _lhsIallTypeConstructors ] + Just _ -> [] + {-# INLINE rule909 #-} + rule909 = \ (_ :: ()) -> + [] + {-# INLINE rule910 #-} + rule910 = \ (_ :: ()) -> + [] + {-# INLINE rule911 #-} + rule911 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Constructor _rangeIself _nameIself + {-# INLINE rule912 #-} + rule912 = \ _self -> + _self + {-# INLINE rule913 #-} + rule913 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule914 #-} + rule914 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule915 #-} + rule915 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule916 #-} + rule916 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Expression_Parenthesized #-} +sem_Expression_Parenthesized :: T_Range -> T_Expression -> T_Expression +sem_Expression_Parenthesized arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule917 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule918 _expressionIunboundNames + _self = rule919 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule920 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule921 _expressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule922 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule923 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule924 _expressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule925 _expressionIwarnings + _expressionOallTypeConstructors = rule926 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule927 _lhsIallValueConstructors + _expressionOclassEnvironment = rule928 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule929 _lhsIcollectScopeInfos + _expressionOcounter = rule930 _lhsIcounter + _expressionOkindErrors = rule931 _lhsIkindErrors + _expressionOmiscerrors = rule932 _lhsImiscerrors + _expressionOnamesInScope = rule933 _lhsInamesInScope + _expressionOoptions = rule934 _lhsIoptions + _expressionOorderedTypeSynonyms = rule935 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule936 _lhsItypeConstructors + _expressionOvalueConstructors = rule937 _lhsIvalueConstructors + _expressionOwarnings = rule938 _lhsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule917 #-} + rule917 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule918 #-} + rule918 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule919 #-} + rule919 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Parenthesized _rangeIself _expressionIself + {-# INLINE rule920 #-} + rule920 = \ _self -> + _self + {-# INLINE rule921 #-} + rule921 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule922 #-} + rule922 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule923 #-} + rule923 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule924 #-} + rule924 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule925 #-} + rule925 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule926 #-} + rule926 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule927 #-} + rule927 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule928 #-} + rule928 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule929 #-} + rule929 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule930 #-} + rule930 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule931 #-} + rule931 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule932 #-} + rule932 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule933 #-} + rule933 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule934 #-} + rule934 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule935 #-} + rule935 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule936 #-} + rule936 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule937 #-} + rule937 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule938 #-} + rule938 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Expression_NormalApplication #-} +sem_Expression_NormalApplication :: T_Range -> T_Expression -> T_Expressions -> T_Expression +sem_Expression_NormalApplication arg_range_ arg_function_ arg_arguments_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_function_)) + _argumentsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _functionIcollectInstances _functionIcollectScopeInfos _functionIcounter _functionIkindErrors _functionImiscerrors _functionIself _functionIunboundNames _functionIwarnings) = inv_Expression_s41 _functionX41 (T_Expression_vIn40 _functionOallTypeConstructors _functionOallValueConstructors _functionOclassEnvironment _functionOcollectScopeInfos _functionOcounter _functionOkindErrors _functionOmiscerrors _functionOnamesInScope _functionOoptions _functionOorderedTypeSynonyms _functionOtypeConstructors _functionOvalueConstructors _functionOwarnings) + (T_Expressions_vOut43 _argumentsIcollectInstances _argumentsIcollectScopeInfos _argumentsIcounter _argumentsIkindErrors _argumentsImiscerrors _argumentsIself _argumentsIunboundNames _argumentsIwarnings) = inv_Expressions_s44 _argumentsX44 (T_Expressions_vIn43 _argumentsOallTypeConstructors _argumentsOallValueConstructors _argumentsOclassEnvironment _argumentsOcollectScopeInfos _argumentsOcounter _argumentsOkindErrors _argumentsOmiscerrors _argumentsOnamesInScope _argumentsOoptions _argumentsOorderedTypeSynonyms _argumentsOtypeConstructors _argumentsOvalueConstructors _argumentsOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule939 _argumentsIcollectInstances _functionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule940 _argumentsIunboundNames _functionIunboundNames + _self = rule941 _argumentsIself _functionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule942 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule943 _argumentsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule944 _argumentsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule945 _argumentsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule946 _argumentsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule947 _argumentsIwarnings + _functionOallTypeConstructors = rule948 _lhsIallTypeConstructors + _functionOallValueConstructors = rule949 _lhsIallValueConstructors + _functionOclassEnvironment = rule950 _lhsIclassEnvironment + _functionOcollectScopeInfos = rule951 _lhsIcollectScopeInfos + _functionOcounter = rule952 _lhsIcounter + _functionOkindErrors = rule953 _lhsIkindErrors + _functionOmiscerrors = rule954 _lhsImiscerrors + _functionOnamesInScope = rule955 _lhsInamesInScope + _functionOoptions = rule956 _lhsIoptions + _functionOorderedTypeSynonyms = rule957 _lhsIorderedTypeSynonyms + _functionOtypeConstructors = rule958 _lhsItypeConstructors + _functionOvalueConstructors = rule959 _lhsIvalueConstructors + _functionOwarnings = rule960 _lhsIwarnings + _argumentsOallTypeConstructors = rule961 _lhsIallTypeConstructors + _argumentsOallValueConstructors = rule962 _lhsIallValueConstructors + _argumentsOclassEnvironment = rule963 _lhsIclassEnvironment + _argumentsOcollectScopeInfos = rule964 _functionIcollectScopeInfos + _argumentsOcounter = rule965 _functionIcounter + _argumentsOkindErrors = rule966 _functionIkindErrors + _argumentsOmiscerrors = rule967 _functionImiscerrors + _argumentsOnamesInScope = rule968 _lhsInamesInScope + _argumentsOoptions = rule969 _lhsIoptions + _argumentsOorderedTypeSynonyms = rule970 _lhsIorderedTypeSynonyms + _argumentsOtypeConstructors = rule971 _lhsItypeConstructors + _argumentsOvalueConstructors = rule972 _lhsIvalueConstructors + _argumentsOwarnings = rule973 _functionIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule939 #-} + rule939 = \ ((_argumentsIcollectInstances) :: [(Name, Instance)]) ((_functionIcollectInstances) :: [(Name, Instance)]) -> + _functionIcollectInstances ++ _argumentsIcollectInstances + {-# INLINE rule940 #-} + rule940 = \ ((_argumentsIunboundNames) :: Names) ((_functionIunboundNames) :: Names) -> + _functionIunboundNames ++ _argumentsIunboundNames + {-# INLINE rule941 #-} + rule941 = \ ((_argumentsIself) :: Expressions) ((_functionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NormalApplication _rangeIself _functionIself _argumentsIself + {-# INLINE rule942 #-} + rule942 = \ _self -> + _self + {-# INLINE rule943 #-} + rule943 = \ ((_argumentsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _argumentsIcollectScopeInfos + {-# INLINE rule944 #-} + rule944 = \ ((_argumentsIcounter) :: Int) -> + _argumentsIcounter + {-# INLINE rule945 #-} + rule945 = \ ((_argumentsIkindErrors) :: [Error]) -> + _argumentsIkindErrors + {-# INLINE rule946 #-} + rule946 = \ ((_argumentsImiscerrors) :: [Error]) -> + _argumentsImiscerrors + {-# INLINE rule947 #-} + rule947 = \ ((_argumentsIwarnings) :: [Warning]) -> + _argumentsIwarnings + {-# INLINE rule948 #-} + rule948 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule949 #-} + rule949 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule950 #-} + rule950 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule951 #-} + rule951 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule952 #-} + rule952 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule953 #-} + rule953 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule954 #-} + rule954 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule955 #-} + rule955 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule956 #-} + rule956 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule957 #-} + rule957 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule958 #-} + rule958 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule959 #-} + rule959 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule960 #-} + rule960 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule961 #-} + rule961 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule962 #-} + rule962 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule963 #-} + rule963 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule964 #-} + rule964 = \ ((_functionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _functionIcollectScopeInfos + {-# INLINE rule965 #-} + rule965 = \ ((_functionIcounter) :: Int) -> + _functionIcounter + {-# INLINE rule966 #-} + rule966 = \ ((_functionIkindErrors) :: [Error]) -> + _functionIkindErrors + {-# INLINE rule967 #-} + rule967 = \ ((_functionImiscerrors) :: [Error]) -> + _functionImiscerrors + {-# INLINE rule968 #-} + rule968 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule969 #-} + rule969 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule970 #-} + rule970 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule971 #-} + rule971 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule972 #-} + rule972 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule973 #-} + rule973 = \ ((_functionIwarnings) :: [Warning]) -> + _functionIwarnings +{-# NOINLINE sem_Expression_InfixApplication #-} +sem_Expression_InfixApplication :: T_Range -> T_MaybeExpression -> T_Expression -> T_MaybeExpression -> T_Expression +sem_Expression_InfixApplication arg_range_ arg_leftExpression_ arg_operator_ arg_rightExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_leftExpression_)) + _operatorX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_operator_)) + _rightExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_rightExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeExpression_vOut94 _leftExpressionIcollectInstances _leftExpressionIcollectScopeInfos _leftExpressionIcounter _leftExpressionIkindErrors _leftExpressionImiscerrors _leftExpressionIself _leftExpressionIunboundNames _leftExpressionIwarnings) = inv_MaybeExpression_s95 _leftExpressionX95 (T_MaybeExpression_vIn94 _leftExpressionOallTypeConstructors _leftExpressionOallValueConstructors _leftExpressionOclassEnvironment _leftExpressionOcollectScopeInfos _leftExpressionOcounter _leftExpressionOkindErrors _leftExpressionOmiscerrors _leftExpressionOnamesInScope _leftExpressionOoptions _leftExpressionOorderedTypeSynonyms _leftExpressionOtypeConstructors _leftExpressionOvalueConstructors _leftExpressionOwarnings) + (T_Expression_vOut40 _operatorIcollectInstances _operatorIcollectScopeInfos _operatorIcounter _operatorIkindErrors _operatorImiscerrors _operatorIself _operatorIunboundNames _operatorIwarnings) = inv_Expression_s41 _operatorX41 (T_Expression_vIn40 _operatorOallTypeConstructors _operatorOallValueConstructors _operatorOclassEnvironment _operatorOcollectScopeInfos _operatorOcounter _operatorOkindErrors _operatorOmiscerrors _operatorOnamesInScope _operatorOoptions _operatorOorderedTypeSynonyms _operatorOtypeConstructors _operatorOvalueConstructors _operatorOwarnings) + (T_MaybeExpression_vOut94 _rightExpressionIcollectInstances _rightExpressionIcollectScopeInfos _rightExpressionIcounter _rightExpressionIkindErrors _rightExpressionImiscerrors _rightExpressionIself _rightExpressionIunboundNames _rightExpressionIwarnings) = inv_MaybeExpression_s95 _rightExpressionX95 (T_MaybeExpression_vIn94 _rightExpressionOallTypeConstructors _rightExpressionOallValueConstructors _rightExpressionOclassEnvironment _rightExpressionOcollectScopeInfos _rightExpressionOcounter _rightExpressionOkindErrors _rightExpressionOmiscerrors _rightExpressionOnamesInScope _rightExpressionOoptions _rightExpressionOorderedTypeSynonyms _rightExpressionOtypeConstructors _rightExpressionOvalueConstructors _rightExpressionOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule974 _leftExpressionIcollectInstances _operatorIcollectInstances _rightExpressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule975 _leftExpressionIunboundNames _operatorIunboundNames _rightExpressionIunboundNames + _self = rule976 _leftExpressionIself _operatorIself _rangeIself _rightExpressionIself + _lhsOself :: Expression + _lhsOself = rule977 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule978 _rightExpressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule979 _rightExpressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule980 _rightExpressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule981 _rightExpressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule982 _rightExpressionIwarnings + _leftExpressionOallTypeConstructors = rule983 _lhsIallTypeConstructors + _leftExpressionOallValueConstructors = rule984 _lhsIallValueConstructors + _leftExpressionOclassEnvironment = rule985 _lhsIclassEnvironment + _leftExpressionOcollectScopeInfos = rule986 _lhsIcollectScopeInfos + _leftExpressionOcounter = rule987 _lhsIcounter + _leftExpressionOkindErrors = rule988 _lhsIkindErrors + _leftExpressionOmiscerrors = rule989 _lhsImiscerrors + _leftExpressionOnamesInScope = rule990 _lhsInamesInScope + _leftExpressionOoptions = rule991 _lhsIoptions + _leftExpressionOorderedTypeSynonyms = rule992 _lhsIorderedTypeSynonyms + _leftExpressionOtypeConstructors = rule993 _lhsItypeConstructors + _leftExpressionOvalueConstructors = rule994 _lhsIvalueConstructors + _leftExpressionOwarnings = rule995 _lhsIwarnings + _operatorOallTypeConstructors = rule996 _lhsIallTypeConstructors + _operatorOallValueConstructors = rule997 _lhsIallValueConstructors + _operatorOclassEnvironment = rule998 _lhsIclassEnvironment + _operatorOcollectScopeInfos = rule999 _leftExpressionIcollectScopeInfos + _operatorOcounter = rule1000 _leftExpressionIcounter + _operatorOkindErrors = rule1001 _leftExpressionIkindErrors + _operatorOmiscerrors = rule1002 _leftExpressionImiscerrors + _operatorOnamesInScope = rule1003 _lhsInamesInScope + _operatorOoptions = rule1004 _lhsIoptions + _operatorOorderedTypeSynonyms = rule1005 _lhsIorderedTypeSynonyms + _operatorOtypeConstructors = rule1006 _lhsItypeConstructors + _operatorOvalueConstructors = rule1007 _lhsIvalueConstructors + _operatorOwarnings = rule1008 _leftExpressionIwarnings + _rightExpressionOallTypeConstructors = rule1009 _lhsIallTypeConstructors + _rightExpressionOallValueConstructors = rule1010 _lhsIallValueConstructors + _rightExpressionOclassEnvironment = rule1011 _lhsIclassEnvironment + _rightExpressionOcollectScopeInfos = rule1012 _operatorIcollectScopeInfos + _rightExpressionOcounter = rule1013 _operatorIcounter + _rightExpressionOkindErrors = rule1014 _operatorIkindErrors + _rightExpressionOmiscerrors = rule1015 _operatorImiscerrors + _rightExpressionOnamesInScope = rule1016 _lhsInamesInScope + _rightExpressionOoptions = rule1017 _lhsIoptions + _rightExpressionOorderedTypeSynonyms = rule1018 _lhsIorderedTypeSynonyms + _rightExpressionOtypeConstructors = rule1019 _lhsItypeConstructors + _rightExpressionOvalueConstructors = rule1020 _lhsIvalueConstructors + _rightExpressionOwarnings = rule1021 _operatorIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule974 #-} + rule974 = \ ((_leftExpressionIcollectInstances) :: [(Name, Instance)]) ((_operatorIcollectInstances) :: [(Name, Instance)]) ((_rightExpressionIcollectInstances) :: [(Name, Instance)]) -> + _leftExpressionIcollectInstances ++ _operatorIcollectInstances ++ _rightExpressionIcollectInstances + {-# INLINE rule975 #-} + rule975 = \ ((_leftExpressionIunboundNames) :: Names) ((_operatorIunboundNames) :: Names) ((_rightExpressionIunboundNames) :: Names) -> + _leftExpressionIunboundNames ++ _operatorIunboundNames ++ _rightExpressionIunboundNames + {-# INLINE rule976 #-} + rule976 = \ ((_leftExpressionIself) :: MaybeExpression) ((_operatorIself) :: Expression) ((_rangeIself) :: Range) ((_rightExpressionIself) :: MaybeExpression) -> + Expression_InfixApplication _rangeIself _leftExpressionIself _operatorIself _rightExpressionIself + {-# INLINE rule977 #-} + rule977 = \ _self -> + _self + {-# INLINE rule978 #-} + rule978 = \ ((_rightExpressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _rightExpressionIcollectScopeInfos + {-# INLINE rule979 #-} + rule979 = \ ((_rightExpressionIcounter) :: Int) -> + _rightExpressionIcounter + {-# INLINE rule980 #-} + rule980 = \ ((_rightExpressionIkindErrors) :: [Error]) -> + _rightExpressionIkindErrors + {-# INLINE rule981 #-} + rule981 = \ ((_rightExpressionImiscerrors) :: [Error]) -> + _rightExpressionImiscerrors + {-# INLINE rule982 #-} + rule982 = \ ((_rightExpressionIwarnings) :: [Warning]) -> + _rightExpressionIwarnings + {-# INLINE rule983 #-} + rule983 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule984 #-} + rule984 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule985 #-} + rule985 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule986 #-} + rule986 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule987 #-} + rule987 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule988 #-} + rule988 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule989 #-} + rule989 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule990 #-} + rule990 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule991 #-} + rule991 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule992 #-} + rule992 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule993 #-} + rule993 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule994 #-} + rule994 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule995 #-} + rule995 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule996 #-} + rule996 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule997 #-} + rule997 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule998 #-} + rule998 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule999 #-} + rule999 = \ ((_leftExpressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _leftExpressionIcollectScopeInfos + {-# INLINE rule1000 #-} + rule1000 = \ ((_leftExpressionIcounter) :: Int) -> + _leftExpressionIcounter + {-# INLINE rule1001 #-} + rule1001 = \ ((_leftExpressionIkindErrors) :: [Error]) -> + _leftExpressionIkindErrors + {-# INLINE rule1002 #-} + rule1002 = \ ((_leftExpressionImiscerrors) :: [Error]) -> + _leftExpressionImiscerrors + {-# INLINE rule1003 #-} + rule1003 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1004 #-} + rule1004 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1005 #-} + rule1005 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1006 #-} + rule1006 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1007 #-} + rule1007 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1008 #-} + rule1008 = \ ((_leftExpressionIwarnings) :: [Warning]) -> + _leftExpressionIwarnings + {-# INLINE rule1009 #-} + rule1009 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1010 #-} + rule1010 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1011 #-} + rule1011 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1012 #-} + rule1012 = \ ((_operatorIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _operatorIcollectScopeInfos + {-# INLINE rule1013 #-} + rule1013 = \ ((_operatorIcounter) :: Int) -> + _operatorIcounter + {-# INLINE rule1014 #-} + rule1014 = \ ((_operatorIkindErrors) :: [Error]) -> + _operatorIkindErrors + {-# INLINE rule1015 #-} + rule1015 = \ ((_operatorImiscerrors) :: [Error]) -> + _operatorImiscerrors + {-# INLINE rule1016 #-} + rule1016 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1017 #-} + rule1017 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1018 #-} + rule1018 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1019 #-} + rule1019 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1020 #-} + rule1020 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1021 #-} + rule1021 = \ ((_operatorIwarnings) :: [Warning]) -> + _operatorIwarnings +{-# NOINLINE sem_Expression_If #-} +sem_Expression_If :: T_Range -> T_Expression -> T_Expression -> T_Expression -> T_Expression +sem_Expression_If arg_range_ arg_guardExpression_ arg_thenExpression_ arg_elseExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guardExpression_)) + _thenExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_thenExpression_)) + _elseExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_elseExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardExpressionIcollectInstances _guardExpressionIcollectScopeInfos _guardExpressionIcounter _guardExpressionIkindErrors _guardExpressionImiscerrors _guardExpressionIself _guardExpressionIunboundNames _guardExpressionIwarnings) = inv_Expression_s41 _guardExpressionX41 (T_Expression_vIn40 _guardExpressionOallTypeConstructors _guardExpressionOallValueConstructors _guardExpressionOclassEnvironment _guardExpressionOcollectScopeInfos _guardExpressionOcounter _guardExpressionOkindErrors _guardExpressionOmiscerrors _guardExpressionOnamesInScope _guardExpressionOoptions _guardExpressionOorderedTypeSynonyms _guardExpressionOtypeConstructors _guardExpressionOvalueConstructors _guardExpressionOwarnings) + (T_Expression_vOut40 _thenExpressionIcollectInstances _thenExpressionIcollectScopeInfos _thenExpressionIcounter _thenExpressionIkindErrors _thenExpressionImiscerrors _thenExpressionIself _thenExpressionIunboundNames _thenExpressionIwarnings) = inv_Expression_s41 _thenExpressionX41 (T_Expression_vIn40 _thenExpressionOallTypeConstructors _thenExpressionOallValueConstructors _thenExpressionOclassEnvironment _thenExpressionOcollectScopeInfos _thenExpressionOcounter _thenExpressionOkindErrors _thenExpressionOmiscerrors _thenExpressionOnamesInScope _thenExpressionOoptions _thenExpressionOorderedTypeSynonyms _thenExpressionOtypeConstructors _thenExpressionOvalueConstructors _thenExpressionOwarnings) + (T_Expression_vOut40 _elseExpressionIcollectInstances _elseExpressionIcollectScopeInfos _elseExpressionIcounter _elseExpressionIkindErrors _elseExpressionImiscerrors _elseExpressionIself _elseExpressionIunboundNames _elseExpressionIwarnings) = inv_Expression_s41 _elseExpressionX41 (T_Expression_vIn40 _elseExpressionOallTypeConstructors _elseExpressionOallValueConstructors _elseExpressionOclassEnvironment _elseExpressionOcollectScopeInfos _elseExpressionOcounter _elseExpressionOkindErrors _elseExpressionOmiscerrors _elseExpressionOnamesInScope _elseExpressionOoptions _elseExpressionOorderedTypeSynonyms _elseExpressionOtypeConstructors _elseExpressionOvalueConstructors _elseExpressionOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1022 _elseExpressionIcollectInstances _guardExpressionIcollectInstances _thenExpressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1023 _elseExpressionIunboundNames _guardExpressionIunboundNames _thenExpressionIunboundNames + _self = rule1024 _elseExpressionIself _guardExpressionIself _rangeIself _thenExpressionIself + _lhsOself :: Expression + _lhsOself = rule1025 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1026 _elseExpressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1027 _elseExpressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1028 _elseExpressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1029 _elseExpressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1030 _elseExpressionIwarnings + _guardExpressionOallTypeConstructors = rule1031 _lhsIallTypeConstructors + _guardExpressionOallValueConstructors = rule1032 _lhsIallValueConstructors + _guardExpressionOclassEnvironment = rule1033 _lhsIclassEnvironment + _guardExpressionOcollectScopeInfos = rule1034 _lhsIcollectScopeInfos + _guardExpressionOcounter = rule1035 _lhsIcounter + _guardExpressionOkindErrors = rule1036 _lhsIkindErrors + _guardExpressionOmiscerrors = rule1037 _lhsImiscerrors + _guardExpressionOnamesInScope = rule1038 _lhsInamesInScope + _guardExpressionOoptions = rule1039 _lhsIoptions + _guardExpressionOorderedTypeSynonyms = rule1040 _lhsIorderedTypeSynonyms + _guardExpressionOtypeConstructors = rule1041 _lhsItypeConstructors + _guardExpressionOvalueConstructors = rule1042 _lhsIvalueConstructors + _guardExpressionOwarnings = rule1043 _lhsIwarnings + _thenExpressionOallTypeConstructors = rule1044 _lhsIallTypeConstructors + _thenExpressionOallValueConstructors = rule1045 _lhsIallValueConstructors + _thenExpressionOclassEnvironment = rule1046 _lhsIclassEnvironment + _thenExpressionOcollectScopeInfos = rule1047 _guardExpressionIcollectScopeInfos + _thenExpressionOcounter = rule1048 _guardExpressionIcounter + _thenExpressionOkindErrors = rule1049 _guardExpressionIkindErrors + _thenExpressionOmiscerrors = rule1050 _guardExpressionImiscerrors + _thenExpressionOnamesInScope = rule1051 _lhsInamesInScope + _thenExpressionOoptions = rule1052 _lhsIoptions + _thenExpressionOorderedTypeSynonyms = rule1053 _lhsIorderedTypeSynonyms + _thenExpressionOtypeConstructors = rule1054 _lhsItypeConstructors + _thenExpressionOvalueConstructors = rule1055 _lhsIvalueConstructors + _thenExpressionOwarnings = rule1056 _guardExpressionIwarnings + _elseExpressionOallTypeConstructors = rule1057 _lhsIallTypeConstructors + _elseExpressionOallValueConstructors = rule1058 _lhsIallValueConstructors + _elseExpressionOclassEnvironment = rule1059 _lhsIclassEnvironment + _elseExpressionOcollectScopeInfos = rule1060 _thenExpressionIcollectScopeInfos + _elseExpressionOcounter = rule1061 _thenExpressionIcounter + _elseExpressionOkindErrors = rule1062 _thenExpressionIkindErrors + _elseExpressionOmiscerrors = rule1063 _thenExpressionImiscerrors + _elseExpressionOnamesInScope = rule1064 _lhsInamesInScope + _elseExpressionOoptions = rule1065 _lhsIoptions + _elseExpressionOorderedTypeSynonyms = rule1066 _lhsIorderedTypeSynonyms + _elseExpressionOtypeConstructors = rule1067 _lhsItypeConstructors + _elseExpressionOvalueConstructors = rule1068 _lhsIvalueConstructors + _elseExpressionOwarnings = rule1069 _thenExpressionIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1022 #-} + rule1022 = \ ((_elseExpressionIcollectInstances) :: [(Name, Instance)]) ((_guardExpressionIcollectInstances) :: [(Name, Instance)]) ((_thenExpressionIcollectInstances) :: [(Name, Instance)]) -> + _guardExpressionIcollectInstances ++ _thenExpressionIcollectInstances ++ _elseExpressionIcollectInstances + {-# INLINE rule1023 #-} + rule1023 = \ ((_elseExpressionIunboundNames) :: Names) ((_guardExpressionIunboundNames) :: Names) ((_thenExpressionIunboundNames) :: Names) -> + _guardExpressionIunboundNames ++ _thenExpressionIunboundNames ++ _elseExpressionIunboundNames + {-# INLINE rule1024 #-} + rule1024 = \ ((_elseExpressionIself) :: Expression) ((_guardExpressionIself) :: Expression) ((_rangeIself) :: Range) ((_thenExpressionIself) :: Expression) -> + Expression_If _rangeIself _guardExpressionIself _thenExpressionIself _elseExpressionIself + {-# INLINE rule1025 #-} + rule1025 = \ _self -> + _self + {-# INLINE rule1026 #-} + rule1026 = \ ((_elseExpressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _elseExpressionIcollectScopeInfos + {-# INLINE rule1027 #-} + rule1027 = \ ((_elseExpressionIcounter) :: Int) -> + _elseExpressionIcounter + {-# INLINE rule1028 #-} + rule1028 = \ ((_elseExpressionIkindErrors) :: [Error]) -> + _elseExpressionIkindErrors + {-# INLINE rule1029 #-} + rule1029 = \ ((_elseExpressionImiscerrors) :: [Error]) -> + _elseExpressionImiscerrors + {-# INLINE rule1030 #-} + rule1030 = \ ((_elseExpressionIwarnings) :: [Warning]) -> + _elseExpressionIwarnings + {-# INLINE rule1031 #-} + rule1031 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1032 #-} + rule1032 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1033 #-} + rule1033 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1034 #-} + rule1034 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1035 #-} + rule1035 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1036 #-} + rule1036 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1037 #-} + rule1037 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1038 #-} + rule1038 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1039 #-} + rule1039 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1040 #-} + rule1040 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1041 #-} + rule1041 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1042 #-} + rule1042 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1043 #-} + rule1043 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1044 #-} + rule1044 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1045 #-} + rule1045 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1046 #-} + rule1046 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1047 #-} + rule1047 = \ ((_guardExpressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _guardExpressionIcollectScopeInfos + {-# INLINE rule1048 #-} + rule1048 = \ ((_guardExpressionIcounter) :: Int) -> + _guardExpressionIcounter + {-# INLINE rule1049 #-} + rule1049 = \ ((_guardExpressionIkindErrors) :: [Error]) -> + _guardExpressionIkindErrors + {-# INLINE rule1050 #-} + rule1050 = \ ((_guardExpressionImiscerrors) :: [Error]) -> + _guardExpressionImiscerrors + {-# INLINE rule1051 #-} + rule1051 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1052 #-} + rule1052 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1053 #-} + rule1053 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1054 #-} + rule1054 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1055 #-} + rule1055 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1056 #-} + rule1056 = \ ((_guardExpressionIwarnings) :: [Warning]) -> + _guardExpressionIwarnings + {-# INLINE rule1057 #-} + rule1057 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1058 #-} + rule1058 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1059 #-} + rule1059 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1060 #-} + rule1060 = \ ((_thenExpressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _thenExpressionIcollectScopeInfos + {-# INLINE rule1061 #-} + rule1061 = \ ((_thenExpressionIcounter) :: Int) -> + _thenExpressionIcounter + {-# INLINE rule1062 #-} + rule1062 = \ ((_thenExpressionIkindErrors) :: [Error]) -> + _thenExpressionIkindErrors + {-# INLINE rule1063 #-} + rule1063 = \ ((_thenExpressionImiscerrors) :: [Error]) -> + _thenExpressionImiscerrors + {-# INLINE rule1064 #-} + rule1064 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1065 #-} + rule1065 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1066 #-} + rule1066 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1067 #-} + rule1067 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1068 #-} + rule1068 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1069 #-} + rule1069 = \ ((_thenExpressionIwarnings) :: [Warning]) -> + _thenExpressionIwarnings +{-# NOINLINE sem_Expression_Lambda #-} +sem_Expression_Lambda :: T_Range -> T_Patterns -> T_Expression -> T_Expression +sem_Expression_Lambda arg_range_ arg_patterns_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIcollectScopeInfos _patternsIcounter _patternsImiscerrors _patternsInumberOfPatterns _patternsIpatVarNames _patternsIself _patternsIunboundNames _patternsIwarnings) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOallTypeConstructors _patternsOallValueConstructors _patternsOcollectScopeInfos _patternsOcounter _patternsOlhsPattern _patternsOmiscerrors _patternsOnamesInScope _patternsOtypeConstructors _patternsOvalueConstructors _patternsOwarnings) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + (_namesInScope,_unboundNames,_scopeInfo) = rule1070 _expressionIunboundNames _lhsInamesInScope _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1071 _unboundNames + _patternsOlhsPattern = rule1072 () + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1073 _expressionIcollectScopeInfos _scopeInfo + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1074 _expressionIcollectInstances + _self = rule1075 _expressionIself _patternsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1076 _self + _lhsOcounter :: Int + _lhsOcounter = rule1077 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1078 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1079 _expressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1080 _expressionIwarnings + _patternsOallTypeConstructors = rule1081 _lhsIallTypeConstructors + _patternsOallValueConstructors = rule1082 _lhsIallValueConstructors + _patternsOcollectScopeInfos = rule1083 _lhsIcollectScopeInfos + _patternsOcounter = rule1084 _lhsIcounter + _patternsOmiscerrors = rule1085 _lhsImiscerrors + _patternsOnamesInScope = rule1086 _namesInScope + _patternsOtypeConstructors = rule1087 _lhsItypeConstructors + _patternsOvalueConstructors = rule1088 _lhsIvalueConstructors + _patternsOwarnings = rule1089 _lhsIwarnings + _expressionOallTypeConstructors = rule1090 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule1091 _lhsIallValueConstructors + _expressionOclassEnvironment = rule1092 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule1093 _patternsIcollectScopeInfos + _expressionOcounter = rule1094 _patternsIcounter + _expressionOkindErrors = rule1095 _lhsIkindErrors + _expressionOmiscerrors = rule1096 _patternsImiscerrors + _expressionOnamesInScope = rule1097 _namesInScope + _expressionOoptions = rule1098 _lhsIoptions + _expressionOorderedTypeSynonyms = rule1099 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule1100 _lhsItypeConstructors + _expressionOvalueConstructors = rule1101 _lhsIvalueConstructors + _expressionOwarnings = rule1102 _patternsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1070 #-} + rule1070 = \ ((_expressionIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_patternsIpatVarNames) :: Names) -> + changeOfScope _patternsIpatVarNames _expressionIunboundNames _lhsInamesInScope + {-# INLINE rule1071 #-} + rule1071 = \ _unboundNames -> + _unboundNames + {-# INLINE rule1072 #-} + rule1072 = \ (_ :: ()) -> + False + {-# INLINE rule1073 #-} + rule1073 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) _scopeInfo -> + (_scopeInfo, Variable) : _expressionIcollectScopeInfos + {-# INLINE rule1074 #-} + rule1074 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule1075 #-} + rule1075 = \ ((_expressionIself) :: Expression) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Expression_Lambda _rangeIself _patternsIself _expressionIself + {-# INLINE rule1076 #-} + rule1076 = \ _self -> + _self + {-# INLINE rule1077 #-} + rule1077 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1078 #-} + rule1078 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule1079 #-} + rule1079 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule1080 #-} + rule1080 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule1081 #-} + rule1081 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1082 #-} + rule1082 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1083 #-} + rule1083 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1084 #-} + rule1084 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1085 #-} + rule1085 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1086 #-} + rule1086 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1087 #-} + rule1087 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1088 #-} + rule1088 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1089 #-} + rule1089 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1090 #-} + rule1090 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1091 #-} + rule1091 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1092 #-} + rule1092 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1093 #-} + rule1093 = \ ((_patternsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternsIcollectScopeInfos + {-# INLINE rule1094 #-} + rule1094 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule1095 #-} + rule1095 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1096 #-} + rule1096 = \ ((_patternsImiscerrors) :: [Error]) -> + _patternsImiscerrors + {-# INLINE rule1097 #-} + rule1097 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1098 #-} + rule1098 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1099 #-} + rule1099 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1100 #-} + rule1100 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1101 #-} + rule1101 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1102 #-} + rule1102 = \ ((_patternsIwarnings) :: [Warning]) -> + _patternsIwarnings +{-# NOINLINE sem_Expression_Case #-} +sem_Expression_Case :: T_Range -> T_Expression -> T_Alternatives -> T_Expression +sem_Expression_Case arg_range_ arg_expression_ arg_alternatives_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _alternativesX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_alternatives_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + (T_Alternatives_vOut4 _alternativesIcollectInstances _alternativesIcollectScopeInfos _alternativesIcounter _alternativesIkindErrors _alternativesImiscerrors _alternativesIself _alternativesIunboundNames _alternativesIwarnings) = inv_Alternatives_s5 _alternativesX5 (T_Alternatives_vIn4 _alternativesOallTypeConstructors _alternativesOallValueConstructors _alternativesOclassEnvironment _alternativesOcollectScopeInfos _alternativesOcounter _alternativesOkindErrors _alternativesOmiscerrors _alternativesOnamesInScope _alternativesOoptions _alternativesOorderedTypeSynonyms _alternativesOtypeConstructors _alternativesOvalueConstructors _alternativesOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1103 _alternativesIcollectInstances _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1104 _alternativesIunboundNames _expressionIunboundNames + _self = rule1105 _alternativesIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1106 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1107 _alternativesIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1108 _alternativesIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1109 _alternativesIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1110 _alternativesImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1111 _alternativesIwarnings + _expressionOallTypeConstructors = rule1112 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule1113 _lhsIallValueConstructors + _expressionOclassEnvironment = rule1114 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule1115 _lhsIcollectScopeInfos + _expressionOcounter = rule1116 _lhsIcounter + _expressionOkindErrors = rule1117 _lhsIkindErrors + _expressionOmiscerrors = rule1118 _lhsImiscerrors + _expressionOnamesInScope = rule1119 _lhsInamesInScope + _expressionOoptions = rule1120 _lhsIoptions + _expressionOorderedTypeSynonyms = rule1121 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule1122 _lhsItypeConstructors + _expressionOvalueConstructors = rule1123 _lhsIvalueConstructors + _expressionOwarnings = rule1124 _lhsIwarnings + _alternativesOallTypeConstructors = rule1125 _lhsIallTypeConstructors + _alternativesOallValueConstructors = rule1126 _lhsIallValueConstructors + _alternativesOclassEnvironment = rule1127 _lhsIclassEnvironment + _alternativesOcollectScopeInfos = rule1128 _expressionIcollectScopeInfos + _alternativesOcounter = rule1129 _expressionIcounter + _alternativesOkindErrors = rule1130 _expressionIkindErrors + _alternativesOmiscerrors = rule1131 _expressionImiscerrors + _alternativesOnamesInScope = rule1132 _lhsInamesInScope + _alternativesOoptions = rule1133 _lhsIoptions + _alternativesOorderedTypeSynonyms = rule1134 _lhsIorderedTypeSynonyms + _alternativesOtypeConstructors = rule1135 _lhsItypeConstructors + _alternativesOvalueConstructors = rule1136 _lhsIvalueConstructors + _alternativesOwarnings = rule1137 _expressionIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1103 #-} + rule1103 = \ ((_alternativesIcollectInstances) :: [(Name, Instance)]) ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances ++ _alternativesIcollectInstances + {-# INLINE rule1104 #-} + rule1104 = \ ((_alternativesIunboundNames) :: Names) ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames ++ _alternativesIunboundNames + {-# INLINE rule1105 #-} + rule1105 = \ ((_alternativesIself) :: Alternatives) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Case _rangeIself _expressionIself _alternativesIself + {-# INLINE rule1106 #-} + rule1106 = \ _self -> + _self + {-# INLINE rule1107 #-} + rule1107 = \ ((_alternativesIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _alternativesIcollectScopeInfos + {-# INLINE rule1108 #-} + rule1108 = \ ((_alternativesIcounter) :: Int) -> + _alternativesIcounter + {-# INLINE rule1109 #-} + rule1109 = \ ((_alternativesIkindErrors) :: [Error]) -> + _alternativesIkindErrors + {-# INLINE rule1110 #-} + rule1110 = \ ((_alternativesImiscerrors) :: [Error]) -> + _alternativesImiscerrors + {-# INLINE rule1111 #-} + rule1111 = \ ((_alternativesIwarnings) :: [Warning]) -> + _alternativesIwarnings + {-# INLINE rule1112 #-} + rule1112 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1113 #-} + rule1113 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1114 #-} + rule1114 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1115 #-} + rule1115 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1116 #-} + rule1116 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1117 #-} + rule1117 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1118 #-} + rule1118 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1119 #-} + rule1119 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1120 #-} + rule1120 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1121 #-} + rule1121 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1122 #-} + rule1122 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1123 #-} + rule1123 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1124 #-} + rule1124 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1125 #-} + rule1125 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1126 #-} + rule1126 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1127 #-} + rule1127 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1128 #-} + rule1128 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule1129 #-} + rule1129 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1130 #-} + rule1130 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule1131 #-} + rule1131 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule1132 #-} + rule1132 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1133 #-} + rule1133 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1134 #-} + rule1134 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1135 #-} + rule1135 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1136 #-} + rule1136 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1137 #-} + rule1137 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings +{-# NOINLINE sem_Expression_Let #-} +sem_Expression_Let :: T_Range -> T_Declarations -> T_Expression -> T_Expression +sem_Expression_Let arg_range_ arg_declarations_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIcollectInstances _declarationsIcollectScopeInfos _declarationsIcollectTypeConstructors _declarationsIcollectTypeSynonyms _declarationsIcollectValueConstructors _declarationsIcounter _declarationsIdeclVarNames _declarationsIkindErrors _declarationsImiscerrors _declarationsIoperatorFixities _declarationsIpreviousWasAlsoFB _declarationsIrestrictedNames _declarationsIself _declarationsIsuspiciousFBs _declarationsItypeSignatures _declarationsIunboundNames _declarationsIwarnings) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOallTypeConstructors _declarationsOallValueConstructors _declarationsOclassEnvironment _declarationsOcollectScopeInfos _declarationsOcollectTypeConstructors _declarationsOcollectTypeSynonyms _declarationsOcollectValueConstructors _declarationsOcounter _declarationsOkindErrors _declarationsOmiscerrors _declarationsOnamesInScope _declarationsOoperatorFixities _declarationsOoptions _declarationsOorderedTypeSynonyms _declarationsOpreviousWasAlsoFB _declarationsOsuspiciousFBs _declarationsOtypeConstructors _declarationsOtypeSignatures _declarationsOvalueConstructors _declarationsOwarnings) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + _declarationsOtypeSignatures = rule1138 () + (_namesInScope,_unboundNames,_scopeInfo) = rule1139 _declarationsIdeclVarNames _declarationsIunboundNames _expressionIunboundNames _lhsInamesInScope + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1140 _unboundNames + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1141 _expressionIwarnings _suspiciousErrors + _declarationsOpreviousWasAlsoFB = rule1142 () + _declarationsOsuspiciousFBs = rule1143 () + _suspiciousErrors = rule1144 _declarationsIsuspiciousFBs _declarationsItypeSignatures + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1145 _expressionImiscerrors _typeSignatureErrors + (_,_doubles) = rule1146 _declarationsItypeSignatures + _typeSignatureErrors = rule1147 _declarationsIdeclVarNames _declarationsIrestrictedNames _declarationsItypeSignatures + (_collectTypeConstructors,_collectValueConstructors,_collectTypeSynonyms,_collectConstructorEnv,_derivedFunctions,_operatorFixities) = rule1148 () + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1149 _expressionIcollectScopeInfos _scopeInfo + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1150 _declarationsIcollectInstances _expressionIcollectInstances + _self = rule1151 _declarationsIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1152 _self + _lhsOcounter :: Int + _lhsOcounter = rule1153 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1154 _expressionIkindErrors + _declarationsOallTypeConstructors = rule1155 _lhsIallTypeConstructors + _declarationsOallValueConstructors = rule1156 _lhsIallValueConstructors + _declarationsOclassEnvironment = rule1157 _lhsIclassEnvironment + _declarationsOcollectScopeInfos = rule1158 _lhsIcollectScopeInfos + _declarationsOcollectTypeConstructors = rule1159 _collectTypeConstructors + _declarationsOcollectTypeSynonyms = rule1160 _collectTypeSynonyms + _declarationsOcollectValueConstructors = rule1161 _collectValueConstructors + _declarationsOcounter = rule1162 _lhsIcounter + _declarationsOkindErrors = rule1163 _lhsIkindErrors + _declarationsOmiscerrors = rule1164 _lhsImiscerrors + _declarationsOnamesInScope = rule1165 _namesInScope + _declarationsOoperatorFixities = rule1166 _operatorFixities + _declarationsOoptions = rule1167 _lhsIoptions + _declarationsOorderedTypeSynonyms = rule1168 _lhsIorderedTypeSynonyms + _declarationsOtypeConstructors = rule1169 _lhsItypeConstructors + _declarationsOvalueConstructors = rule1170 _lhsIvalueConstructors + _declarationsOwarnings = rule1171 _lhsIwarnings + _expressionOallTypeConstructors = rule1172 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule1173 _lhsIallValueConstructors + _expressionOclassEnvironment = rule1174 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule1175 _declarationsIcollectScopeInfos + _expressionOcounter = rule1176 _declarationsIcounter + _expressionOkindErrors = rule1177 _declarationsIkindErrors + _expressionOmiscerrors = rule1178 _declarationsImiscerrors + _expressionOnamesInScope = rule1179 _namesInScope + _expressionOoptions = rule1180 _lhsIoptions + _expressionOorderedTypeSynonyms = rule1181 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule1182 _lhsItypeConstructors + _expressionOvalueConstructors = rule1183 _lhsIvalueConstructors + _expressionOwarnings = rule1184 _declarationsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1138 #-} + rule1138 = \ (_ :: ()) -> + [] + {-# INLINE rule1139 #-} + rule1139 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIunboundNames) :: Names) ((_expressionIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) -> + changeOfScope _declarationsIdeclVarNames (_declarationsIunboundNames ++ _expressionIunboundNames) _lhsInamesInScope + {-# INLINE rule1140 #-} + rule1140 = \ _unboundNames -> + _unboundNames + {-# INLINE rule1141 #-} + rule1141 = \ ((_expressionIwarnings) :: [Warning]) _suspiciousErrors -> + _expressionIwarnings ++ + _suspiciousErrors + {-# INLINE rule1142 #-} + rule1142 = \ (_ :: ()) -> + Nothing + {-# INLINE rule1143 #-} + rule1143 = \ (_ :: ()) -> + [] + {-# INLINE rule1144 #-} + rule1144 = \ ((_declarationsIsuspiciousFBs) :: [(Name,Name)]) ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + findSimilarFunctionBindings _declarationsItypeSignatures _declarationsIsuspiciousFBs + {-# INLINE rule1145 #-} + rule1145 = \ ((_expressionImiscerrors) :: [Error]) _typeSignatureErrors -> + _typeSignatureErrors ++ _expressionImiscerrors + {-# INLINE rule1146 #-} + rule1146 = \ ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + uniqueAppearance (map fst _declarationsItypeSignatures) + {-# INLINE rule1147 #-} + rule1147 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIrestrictedNames) :: Names) ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + checkTypeSignatures _declarationsIdeclVarNames _declarationsIrestrictedNames _declarationsItypeSignatures + {-# INLINE rule1148 #-} + rule1148 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "toplevel Expression" + {-# INLINE rule1149 #-} + rule1149 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) _scopeInfo -> + (_scopeInfo, Definition) : _expressionIcollectScopeInfos + {-# INLINE rule1150 #-} + rule1150 = \ ((_declarationsIcollectInstances) :: [(Name, Instance)]) ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _declarationsIcollectInstances ++ _expressionIcollectInstances + {-# INLINE rule1151 #-} + rule1151 = \ ((_declarationsIself) :: Declarations) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Let _rangeIself _declarationsIself _expressionIself + {-# INLINE rule1152 #-} + rule1152 = \ _self -> + _self + {-# INLINE rule1153 #-} + rule1153 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1154 #-} + rule1154 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule1155 #-} + rule1155 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1156 #-} + rule1156 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1157 #-} + rule1157 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1158 #-} + rule1158 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1159 #-} + rule1159 = \ _collectTypeConstructors -> + _collectTypeConstructors + {-# INLINE rule1160 #-} + rule1160 = \ _collectTypeSynonyms -> + _collectTypeSynonyms + {-# INLINE rule1161 #-} + rule1161 = \ _collectValueConstructors -> + _collectValueConstructors + {-# INLINE rule1162 #-} + rule1162 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1163 #-} + rule1163 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1164 #-} + rule1164 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1165 #-} + rule1165 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1166 #-} + rule1166 = \ _operatorFixities -> + _operatorFixities + {-# INLINE rule1167 #-} + rule1167 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1168 #-} + rule1168 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1169 #-} + rule1169 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1170 #-} + rule1170 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1171 #-} + rule1171 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1172 #-} + rule1172 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1173 #-} + rule1173 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1174 #-} + rule1174 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1175 #-} + rule1175 = \ ((_declarationsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _declarationsIcollectScopeInfos + {-# INLINE rule1176 #-} + rule1176 = \ ((_declarationsIcounter) :: Int) -> + _declarationsIcounter + {-# INLINE rule1177 #-} + rule1177 = \ ((_declarationsIkindErrors) :: [Error]) -> + _declarationsIkindErrors + {-# INLINE rule1178 #-} + rule1178 = \ ((_declarationsImiscerrors) :: [Error]) -> + _declarationsImiscerrors + {-# INLINE rule1179 #-} + rule1179 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1180 #-} + rule1180 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1181 #-} + rule1181 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1182 #-} + rule1182 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1183 #-} + rule1183 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1184 #-} + rule1184 = \ ((_declarationsIwarnings) :: [Warning]) -> + _declarationsIwarnings +{-# NOINLINE sem_Expression_Do #-} +sem_Expression_Do :: T_Range -> T_Statements -> T_Expression +sem_Expression_Do arg_range_ arg_statements_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _statementsX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_statements_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Statements_vOut157 _statementsIcollectInstances _statementsIcollectScopeInfos _statementsIcounter _statementsIkindErrors _statementsIlastStatementIsExpr _statementsImiscerrors _statementsInamesInScope _statementsIself _statementsIunboundNames _statementsIwarnings) = inv_Statements_s158 _statementsX158 (T_Statements_vIn157 _statementsOallTypeConstructors _statementsOallValueConstructors _statementsOclassEnvironment _statementsOcollectScopeInfos _statementsOcounter _statementsOkindErrors _statementsOlastStatementIsExpr _statementsOmiscerrors _statementsOnamesInScope _statementsOoptions _statementsOorderedTypeSynonyms _statementsOtypeConstructors _statementsOunboundNames _statementsOvalueConstructors _statementsOwarnings) + _statementsOunboundNames = rule1185 () + _statementsOlastStatementIsExpr = rule1186 () + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1187 _lastStatementErrors _statementsImiscerrors + _lastStatementErrors = rule1188 _statementsIlastStatementIsExpr _statementsIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1189 _statementsIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1190 _statementsIunboundNames + _self = rule1191 _rangeIself _statementsIself + _lhsOself :: Expression + _lhsOself = rule1192 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1193 _statementsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1194 _statementsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1195 _statementsIkindErrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1196 _statementsIwarnings + _statementsOallTypeConstructors = rule1197 _lhsIallTypeConstructors + _statementsOallValueConstructors = rule1198 _lhsIallValueConstructors + _statementsOclassEnvironment = rule1199 _lhsIclassEnvironment + _statementsOcollectScopeInfos = rule1200 _lhsIcollectScopeInfos + _statementsOcounter = rule1201 _lhsIcounter + _statementsOkindErrors = rule1202 _lhsIkindErrors + _statementsOmiscerrors = rule1203 _lhsImiscerrors + _statementsOnamesInScope = rule1204 _lhsInamesInScope + _statementsOoptions = rule1205 _lhsIoptions + _statementsOorderedTypeSynonyms = rule1206 _lhsIorderedTypeSynonyms + _statementsOtypeConstructors = rule1207 _lhsItypeConstructors + _statementsOvalueConstructors = rule1208 _lhsIvalueConstructors + _statementsOwarnings = rule1209 _lhsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1185 #-} + rule1185 = \ (_ :: ()) -> + [] + {-# INLINE rule1186 #-} + rule1186 = \ (_ :: ()) -> + False + {-# INLINE rule1187 #-} + rule1187 = \ _lastStatementErrors ((_statementsImiscerrors) :: [Error]) -> + _lastStatementErrors ++ _statementsImiscerrors + {-# INLINE rule1188 #-} + rule1188 = \ ((_statementsIlastStatementIsExpr) :: Bool) ((_statementsIself) :: Statements) -> + if _statementsIlastStatementIsExpr + then [] + else let range = getStatementRange (last _statementsIself) + in [ LastStatementNotExpr range ] + {-# INLINE rule1189 #-} + rule1189 = \ ((_statementsIcollectInstances) :: [(Name, Instance)]) -> + _statementsIcollectInstances + {-# INLINE rule1190 #-} + rule1190 = \ ((_statementsIunboundNames) :: Names) -> + _statementsIunboundNames + {-# INLINE rule1191 #-} + rule1191 = \ ((_rangeIself) :: Range) ((_statementsIself) :: Statements) -> + Expression_Do _rangeIself _statementsIself + {-# INLINE rule1192 #-} + rule1192 = \ _self -> + _self + {-# INLINE rule1193 #-} + rule1193 = \ ((_statementsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _statementsIcollectScopeInfos + {-# INLINE rule1194 #-} + rule1194 = \ ((_statementsIcounter) :: Int) -> + _statementsIcounter + {-# INLINE rule1195 #-} + rule1195 = \ ((_statementsIkindErrors) :: [Error]) -> + _statementsIkindErrors + {-# INLINE rule1196 #-} + rule1196 = \ ((_statementsIwarnings) :: [Warning]) -> + _statementsIwarnings + {-# INLINE rule1197 #-} + rule1197 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1198 #-} + rule1198 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1199 #-} + rule1199 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1200 #-} + rule1200 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1201 #-} + rule1201 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1202 #-} + rule1202 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1203 #-} + rule1203 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1204 #-} + rule1204 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1205 #-} + rule1205 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1206 #-} + rule1206 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1207 #-} + rule1207 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1208 #-} + rule1208 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1209 #-} + rule1209 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Expression_List #-} +sem_Expression_List :: T_Range -> T_Expressions -> T_Expression +sem_Expression_List arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIcollectInstances _expressionsIcollectScopeInfos _expressionsIcounter _expressionsIkindErrors _expressionsImiscerrors _expressionsIself _expressionsIunboundNames _expressionsIwarnings) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 _expressionsOallTypeConstructors _expressionsOallValueConstructors _expressionsOclassEnvironment _expressionsOcollectScopeInfos _expressionsOcounter _expressionsOkindErrors _expressionsOmiscerrors _expressionsOnamesInScope _expressionsOoptions _expressionsOorderedTypeSynonyms _expressionsOtypeConstructors _expressionsOvalueConstructors _expressionsOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1210 _expressionsIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1211 _expressionsIunboundNames + _self = rule1212 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1213 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1214 _expressionsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1215 _expressionsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1216 _expressionsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1217 _expressionsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1218 _expressionsIwarnings + _expressionsOallTypeConstructors = rule1219 _lhsIallTypeConstructors + _expressionsOallValueConstructors = rule1220 _lhsIallValueConstructors + _expressionsOclassEnvironment = rule1221 _lhsIclassEnvironment + _expressionsOcollectScopeInfos = rule1222 _lhsIcollectScopeInfos + _expressionsOcounter = rule1223 _lhsIcounter + _expressionsOkindErrors = rule1224 _lhsIkindErrors + _expressionsOmiscerrors = rule1225 _lhsImiscerrors + _expressionsOnamesInScope = rule1226 _lhsInamesInScope + _expressionsOoptions = rule1227 _lhsIoptions + _expressionsOorderedTypeSynonyms = rule1228 _lhsIorderedTypeSynonyms + _expressionsOtypeConstructors = rule1229 _lhsItypeConstructors + _expressionsOvalueConstructors = rule1230 _lhsIvalueConstructors + _expressionsOwarnings = rule1231 _lhsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1210 #-} + rule1210 = \ ((_expressionsIcollectInstances) :: [(Name, Instance)]) -> + _expressionsIcollectInstances + {-# INLINE rule1211 #-} + rule1211 = \ ((_expressionsIunboundNames) :: Names) -> + _expressionsIunboundNames + {-# INLINE rule1212 #-} + rule1212 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_List _rangeIself _expressionsIself + {-# INLINE rule1213 #-} + rule1213 = \ _self -> + _self + {-# INLINE rule1214 #-} + rule1214 = \ ((_expressionsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionsIcollectScopeInfos + {-# INLINE rule1215 #-} + rule1215 = \ ((_expressionsIcounter) :: Int) -> + _expressionsIcounter + {-# INLINE rule1216 #-} + rule1216 = \ ((_expressionsIkindErrors) :: [Error]) -> + _expressionsIkindErrors + {-# INLINE rule1217 #-} + rule1217 = \ ((_expressionsImiscerrors) :: [Error]) -> + _expressionsImiscerrors + {-# INLINE rule1218 #-} + rule1218 = \ ((_expressionsIwarnings) :: [Warning]) -> + _expressionsIwarnings + {-# INLINE rule1219 #-} + rule1219 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1220 #-} + rule1220 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1221 #-} + rule1221 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1222 #-} + rule1222 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1223 #-} + rule1223 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1224 #-} + rule1224 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1225 #-} + rule1225 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1226 #-} + rule1226 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1227 #-} + rule1227 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1228 #-} + rule1228 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1229 #-} + rule1229 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1230 #-} + rule1230 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1231 #-} + rule1231 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Expression_Tuple #-} +sem_Expression_Tuple :: T_Range -> T_Expressions -> T_Expression +sem_Expression_Tuple arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIcollectInstances _expressionsIcollectScopeInfos _expressionsIcounter _expressionsIkindErrors _expressionsImiscerrors _expressionsIself _expressionsIunboundNames _expressionsIwarnings) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 _expressionsOallTypeConstructors _expressionsOallValueConstructors _expressionsOclassEnvironment _expressionsOcollectScopeInfos _expressionsOcounter _expressionsOkindErrors _expressionsOmiscerrors _expressionsOnamesInScope _expressionsOoptions _expressionsOorderedTypeSynonyms _expressionsOtypeConstructors _expressionsOvalueConstructors _expressionsOwarnings) + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1232 _expressionsImiscerrors _tupleTooBigErrors + _tupleTooBigErrors = rule1233 _expressionsIself _rangeIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1234 _expressionsIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1235 _expressionsIunboundNames + _self = rule1236 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1237 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1238 _expressionsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1239 _expressionsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1240 _expressionsIkindErrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1241 _expressionsIwarnings + _expressionsOallTypeConstructors = rule1242 _lhsIallTypeConstructors + _expressionsOallValueConstructors = rule1243 _lhsIallValueConstructors + _expressionsOclassEnvironment = rule1244 _lhsIclassEnvironment + _expressionsOcollectScopeInfos = rule1245 _lhsIcollectScopeInfos + _expressionsOcounter = rule1246 _lhsIcounter + _expressionsOkindErrors = rule1247 _lhsIkindErrors + _expressionsOmiscerrors = rule1248 _lhsImiscerrors + _expressionsOnamesInScope = rule1249 _lhsInamesInScope + _expressionsOoptions = rule1250 _lhsIoptions + _expressionsOorderedTypeSynonyms = rule1251 _lhsIorderedTypeSynonyms + _expressionsOtypeConstructors = rule1252 _lhsItypeConstructors + _expressionsOvalueConstructors = rule1253 _lhsIvalueConstructors + _expressionsOwarnings = rule1254 _lhsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1232 #-} + rule1232 = \ ((_expressionsImiscerrors) :: [Error]) _tupleTooBigErrors -> + _tupleTooBigErrors ++ _expressionsImiscerrors + {-# INLINE rule1233 #-} + rule1233 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + [ TupleTooBig _rangeIself + | length _expressionsIself > 10 + ] + {-# INLINE rule1234 #-} + rule1234 = \ ((_expressionsIcollectInstances) :: [(Name, Instance)]) -> + _expressionsIcollectInstances + {-# INLINE rule1235 #-} + rule1235 = \ ((_expressionsIunboundNames) :: Names) -> + _expressionsIunboundNames + {-# INLINE rule1236 #-} + rule1236 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_Tuple _rangeIself _expressionsIself + {-# INLINE rule1237 #-} + rule1237 = \ _self -> + _self + {-# INLINE rule1238 #-} + rule1238 = \ ((_expressionsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionsIcollectScopeInfos + {-# INLINE rule1239 #-} + rule1239 = \ ((_expressionsIcounter) :: Int) -> + _expressionsIcounter + {-# INLINE rule1240 #-} + rule1240 = \ ((_expressionsIkindErrors) :: [Error]) -> + _expressionsIkindErrors + {-# INLINE rule1241 #-} + rule1241 = \ ((_expressionsIwarnings) :: [Warning]) -> + _expressionsIwarnings + {-# INLINE rule1242 #-} + rule1242 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1243 #-} + rule1243 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1244 #-} + rule1244 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1245 #-} + rule1245 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1246 #-} + rule1246 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1247 #-} + rule1247 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1248 #-} + rule1248 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1249 #-} + rule1249 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1250 #-} + rule1250 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1251 #-} + rule1251 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1252 #-} + rule1252 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1253 #-} + rule1253 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1254 #-} + rule1254 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Expression_Comprehension #-} +sem_Expression_Comprehension :: T_Range -> T_Expression -> T_Qualifiers -> T_Expression +sem_Expression_Comprehension arg_range_ arg_expression_ arg_qualifiers_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _qualifiersX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_qualifiers_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + (T_Qualifiers_vOut130 _qualifiersIcollectInstances _qualifiersIcollectScopeInfos _qualifiersIcounter _qualifiersIkindErrors _qualifiersImiscerrors _qualifiersInamesInScope _qualifiersIself _qualifiersIunboundNames _qualifiersIwarnings) = inv_Qualifiers_s131 _qualifiersX131 (T_Qualifiers_vIn130 _qualifiersOallTypeConstructors _qualifiersOallValueConstructors _qualifiersOclassEnvironment _qualifiersOcollectScopeInfos _qualifiersOcounter _qualifiersOkindErrors _qualifiersOmiscerrors _qualifiersOnamesInScope _qualifiersOoptions _qualifiersOorderedTypeSynonyms _qualifiersOtypeConstructors _qualifiersOunboundNames _qualifiersOvalueConstructors _qualifiersOwarnings) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1255 _qualifiersIunboundNames + _expressionOnamesInScope = rule1256 _qualifiersInamesInScope + _qualifiersOnamesInScope = rule1257 _lhsInamesInScope + _qualifiersOunboundNames = rule1258 _expressionIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1259 _expressionIcollectInstances _qualifiersIcollectInstances + _self = rule1260 _expressionIself _qualifiersIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1261 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1262 _qualifiersIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1263 _qualifiersIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1264 _qualifiersIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1265 _qualifiersImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1266 _qualifiersIwarnings + _expressionOallTypeConstructors = rule1267 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule1268 _lhsIallValueConstructors + _expressionOclassEnvironment = rule1269 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule1270 _lhsIcollectScopeInfos + _expressionOcounter = rule1271 _lhsIcounter + _expressionOkindErrors = rule1272 _lhsIkindErrors + _expressionOmiscerrors = rule1273 _lhsImiscerrors + _expressionOoptions = rule1274 _lhsIoptions + _expressionOorderedTypeSynonyms = rule1275 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule1276 _lhsItypeConstructors + _expressionOvalueConstructors = rule1277 _lhsIvalueConstructors + _expressionOwarnings = rule1278 _lhsIwarnings + _qualifiersOallTypeConstructors = rule1279 _lhsIallTypeConstructors + _qualifiersOallValueConstructors = rule1280 _lhsIallValueConstructors + _qualifiersOclassEnvironment = rule1281 _lhsIclassEnvironment + _qualifiersOcollectScopeInfos = rule1282 _expressionIcollectScopeInfos + _qualifiersOcounter = rule1283 _expressionIcounter + _qualifiersOkindErrors = rule1284 _expressionIkindErrors + _qualifiersOmiscerrors = rule1285 _expressionImiscerrors + _qualifiersOoptions = rule1286 _lhsIoptions + _qualifiersOorderedTypeSynonyms = rule1287 _lhsIorderedTypeSynonyms + _qualifiersOtypeConstructors = rule1288 _lhsItypeConstructors + _qualifiersOvalueConstructors = rule1289 _lhsIvalueConstructors + _qualifiersOwarnings = rule1290 _expressionIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1255 #-} + rule1255 = \ ((_qualifiersIunboundNames) :: Names) -> + _qualifiersIunboundNames + {-# INLINE rule1256 #-} + rule1256 = \ ((_qualifiersInamesInScope) :: Names) -> + _qualifiersInamesInScope + {-# INLINE rule1257 #-} + rule1257 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1258 #-} + rule1258 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule1259 #-} + rule1259 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) ((_qualifiersIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances ++ _qualifiersIcollectInstances + {-# INLINE rule1260 #-} + rule1260 = \ ((_expressionIself) :: Expression) ((_qualifiersIself) :: Qualifiers) ((_rangeIself) :: Range) -> + Expression_Comprehension _rangeIself _expressionIself _qualifiersIself + {-# INLINE rule1261 #-} + rule1261 = \ _self -> + _self + {-# INLINE rule1262 #-} + rule1262 = \ ((_qualifiersIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _qualifiersIcollectScopeInfos + {-# INLINE rule1263 #-} + rule1263 = \ ((_qualifiersIcounter) :: Int) -> + _qualifiersIcounter + {-# INLINE rule1264 #-} + rule1264 = \ ((_qualifiersIkindErrors) :: [Error]) -> + _qualifiersIkindErrors + {-# INLINE rule1265 #-} + rule1265 = \ ((_qualifiersImiscerrors) :: [Error]) -> + _qualifiersImiscerrors + {-# INLINE rule1266 #-} + rule1266 = \ ((_qualifiersIwarnings) :: [Warning]) -> + _qualifiersIwarnings + {-# INLINE rule1267 #-} + rule1267 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1268 #-} + rule1268 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1269 #-} + rule1269 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1270 #-} + rule1270 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1271 #-} + rule1271 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1272 #-} + rule1272 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1273 #-} + rule1273 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1274 #-} + rule1274 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1275 #-} + rule1275 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1276 #-} + rule1276 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1277 #-} + rule1277 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1278 #-} + rule1278 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1279 #-} + rule1279 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1280 #-} + rule1280 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1281 #-} + rule1281 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1282 #-} + rule1282 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule1283 #-} + rule1283 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1284 #-} + rule1284 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule1285 #-} + rule1285 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule1286 #-} + rule1286 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1287 #-} + rule1287 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1288 #-} + rule1288 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1289 #-} + rule1289 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1290 #-} + rule1290 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings +{-# NOINLINE sem_Expression_Typed #-} +sem_Expression_Typed :: T_Range -> T_Expression -> T_Type -> T_Expression +sem_Expression_Typed arg_range_ arg_expression_ arg_type_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + (T_Type_vOut163 _typeIcontextRange _typeImiscerrors _typeIself _typeItypevariables _typeIwarnings) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOallTypeConstructors _typeOmiscerrors _typeOoptions _typeOtypeConstructors _typeOwarnings) + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1291 _expressionIkindErrors _newErrors + _newErrors = rule1292 _lhsIallValueConstructors _lhsInamesInScope _lhsItypeConstructors _typeIself + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1293 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1294 _expressionIunboundNames + _self = rule1295 _expressionIself _rangeIself _typeIself + _lhsOself :: Expression + _lhsOself = rule1296 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1297 _expressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1298 _expressionIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1299 _typeImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1300 _typeIwarnings + _expressionOallTypeConstructors = rule1301 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule1302 _lhsIallValueConstructors + _expressionOclassEnvironment = rule1303 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule1304 _lhsIcollectScopeInfos + _expressionOcounter = rule1305 _lhsIcounter + _expressionOkindErrors = rule1306 _lhsIkindErrors + _expressionOmiscerrors = rule1307 _lhsImiscerrors + _expressionOnamesInScope = rule1308 _lhsInamesInScope + _expressionOoptions = rule1309 _lhsIoptions + _expressionOorderedTypeSynonyms = rule1310 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule1311 _lhsItypeConstructors + _expressionOvalueConstructors = rule1312 _lhsIvalueConstructors + _expressionOwarnings = rule1313 _lhsIwarnings + _typeOallTypeConstructors = rule1314 _lhsIallTypeConstructors + _typeOmiscerrors = rule1315 _expressionImiscerrors + _typeOoptions = rule1316 _lhsIoptions + _typeOtypeConstructors = rule1317 _lhsItypeConstructors + _typeOwarnings = rule1318 _expressionIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1291 #-} + rule1291 = \ ((_expressionIkindErrors) :: [Error]) _newErrors -> + _newErrors ++ _expressionIkindErrors + {-# INLINE rule1292 #-} + rule1292 = \ ((_lhsIallValueConstructors) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsItypeConstructors) :: M.Map Name Int) ((_typeIself) :: Type) -> + checkType _lhsItypeConstructors (_lhsInamesInScope ++ _lhsIallValueConstructors) _typeIself + {-# INLINE rule1293 #-} + rule1293 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule1294 #-} + rule1294 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule1295 #-} + rule1295 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Expression_Typed _rangeIself _expressionIself _typeIself + {-# INLINE rule1296 #-} + rule1296 = \ _self -> + _self + {-# INLINE rule1297 #-} + rule1297 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule1298 #-} + rule1298 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1299 #-} + rule1299 = \ ((_typeImiscerrors) :: [Error]) -> + _typeImiscerrors + {-# INLINE rule1300 #-} + rule1300 = \ ((_typeIwarnings) :: [Warning]) -> + _typeIwarnings + {-# INLINE rule1301 #-} + rule1301 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1302 #-} + rule1302 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1303 #-} + rule1303 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1304 #-} + rule1304 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1305 #-} + rule1305 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1306 #-} + rule1306 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1307 #-} + rule1307 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1308 #-} + rule1308 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1309 #-} + rule1309 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1310 #-} + rule1310 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1311 #-} + rule1311 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1312 #-} + rule1312 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1313 #-} + rule1313 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1314 #-} + rule1314 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1315 #-} + rule1315 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule1316 #-} + rule1316 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1317 #-} + rule1317 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1318 #-} + rule1318 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings +{-# NOINLINE sem_Expression_RecordConstruction #-} +sem_Expression_RecordConstruction :: T_Range -> T_Name -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordConstruction arg_range_ arg_name_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIcollectInstances _recordExpressionBindingsIcollectScopeInfos _recordExpressionBindingsIcounter _recordExpressionBindingsIself _recordExpressionBindingsIunboundNames) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 _recordExpressionBindingsOclassEnvironment _recordExpressionBindingsOcollectScopeInfos _recordExpressionBindingsOcounter _recordExpressionBindingsOnamesInScope _recordExpressionBindingsOoptions _recordExpressionBindingsOorderedTypeSynonyms) + (_assumptions,_constraints,_beta) = rule1319 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1320 _recordExpressionBindingsIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1321 _recordExpressionBindingsIunboundNames + _self = rule1322 _nameIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule1323 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1324 _recordExpressionBindingsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1325 _recordExpressionBindingsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1326 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1327 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1328 _lhsIwarnings + _recordExpressionBindingsOclassEnvironment = rule1329 _lhsIclassEnvironment + _recordExpressionBindingsOcollectScopeInfos = rule1330 _lhsIcollectScopeInfos + _recordExpressionBindingsOcounter = rule1331 _lhsIcounter + _recordExpressionBindingsOnamesInScope = rule1332 _lhsInamesInScope + _recordExpressionBindingsOoptions = rule1333 _lhsIoptions + _recordExpressionBindingsOorderedTypeSynonyms = rule1334 _lhsIorderedTypeSynonyms + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1319 #-} + rule1319 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "Expression.RecordConstruction" + {-# INLINE rule1320 #-} + rule1320 = \ ((_recordExpressionBindingsIcollectInstances) :: [(Name, Instance)]) -> + _recordExpressionBindingsIcollectInstances + {-# INLINE rule1321 #-} + rule1321 = \ ((_recordExpressionBindingsIunboundNames) :: Names) -> + _recordExpressionBindingsIunboundNames + {-# INLINE rule1322 #-} + rule1322 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordConstruction _rangeIself _nameIself _recordExpressionBindingsIself + {-# INLINE rule1323 #-} + rule1323 = \ _self -> + _self + {-# INLINE rule1324 #-} + rule1324 = \ ((_recordExpressionBindingsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _recordExpressionBindingsIcollectScopeInfos + {-# INLINE rule1325 #-} + rule1325 = \ ((_recordExpressionBindingsIcounter) :: Int) -> + _recordExpressionBindingsIcounter + {-# INLINE rule1326 #-} + rule1326 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1327 #-} + rule1327 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1328 #-} + rule1328 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1329 #-} + rule1329 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1330 #-} + rule1330 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1331 #-} + rule1331 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1332 #-} + rule1332 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1333 #-} + rule1333 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1334 #-} + rule1334 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms +{-# NOINLINE sem_Expression_RecordUpdate #-} +sem_Expression_RecordUpdate :: T_Range -> T_Expression -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordUpdate arg_range_ arg_expression_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIcollectInstances _recordExpressionBindingsIcollectScopeInfos _recordExpressionBindingsIcounter _recordExpressionBindingsIself _recordExpressionBindingsIunboundNames) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 _recordExpressionBindingsOclassEnvironment _recordExpressionBindingsOcollectScopeInfos _recordExpressionBindingsOcounter _recordExpressionBindingsOnamesInScope _recordExpressionBindingsOoptions _recordExpressionBindingsOorderedTypeSynonyms) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1335 _expressionIcollectInstances _recordExpressionBindingsIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1336 _expressionIunboundNames _recordExpressionBindingsIunboundNames + _self = rule1337 _expressionIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule1338 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1339 _recordExpressionBindingsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1340 _recordExpressionBindingsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1341 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1342 _expressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1343 _expressionIwarnings + _expressionOallTypeConstructors = rule1344 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule1345 _lhsIallValueConstructors + _expressionOclassEnvironment = rule1346 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule1347 _lhsIcollectScopeInfos + _expressionOcounter = rule1348 _lhsIcounter + _expressionOkindErrors = rule1349 _lhsIkindErrors + _expressionOmiscerrors = rule1350 _lhsImiscerrors + _expressionOnamesInScope = rule1351 _lhsInamesInScope + _expressionOoptions = rule1352 _lhsIoptions + _expressionOorderedTypeSynonyms = rule1353 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule1354 _lhsItypeConstructors + _expressionOvalueConstructors = rule1355 _lhsIvalueConstructors + _expressionOwarnings = rule1356 _lhsIwarnings + _recordExpressionBindingsOclassEnvironment = rule1357 _lhsIclassEnvironment + _recordExpressionBindingsOcollectScopeInfos = rule1358 _expressionIcollectScopeInfos + _recordExpressionBindingsOcounter = rule1359 _expressionIcounter + _recordExpressionBindingsOnamesInScope = rule1360 _lhsInamesInScope + _recordExpressionBindingsOoptions = rule1361 _lhsIoptions + _recordExpressionBindingsOorderedTypeSynonyms = rule1362 _lhsIorderedTypeSynonyms + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1335 #-} + rule1335 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) ((_recordExpressionBindingsIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances ++ _recordExpressionBindingsIcollectInstances + {-# INLINE rule1336 #-} + rule1336 = \ ((_expressionIunboundNames) :: Names) ((_recordExpressionBindingsIunboundNames) :: Names) -> + _expressionIunboundNames ++ _recordExpressionBindingsIunboundNames + {-# INLINE rule1337 #-} + rule1337 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordUpdate _rangeIself _expressionIself _recordExpressionBindingsIself + {-# INLINE rule1338 #-} + rule1338 = \ _self -> + _self + {-# INLINE rule1339 #-} + rule1339 = \ ((_recordExpressionBindingsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _recordExpressionBindingsIcollectScopeInfos + {-# INLINE rule1340 #-} + rule1340 = \ ((_recordExpressionBindingsIcounter) :: Int) -> + _recordExpressionBindingsIcounter + {-# INLINE rule1341 #-} + rule1341 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule1342 #-} + rule1342 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule1343 #-} + rule1343 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule1344 #-} + rule1344 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1345 #-} + rule1345 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1346 #-} + rule1346 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1347 #-} + rule1347 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1348 #-} + rule1348 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1349 #-} + rule1349 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1350 #-} + rule1350 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1351 #-} + rule1351 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1352 #-} + rule1352 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1353 #-} + rule1353 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1354 #-} + rule1354 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1355 #-} + rule1355 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1356 #-} + rule1356 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1357 #-} + rule1357 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1358 #-} + rule1358 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule1359 #-} + rule1359 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1360 #-} + rule1360 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1361 #-} + rule1361 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1362 #-} + rule1362 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms +{-# NOINLINE sem_Expression_Enum #-} +sem_Expression_Enum :: T_Range -> T_Expression -> T_MaybeExpression -> T_MaybeExpression -> T_Expression +sem_Expression_Enum arg_range_ arg_from_ arg_then_ arg_to_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fromX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_from_)) + _thenX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_then_)) + _toX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_to_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _fromIcollectInstances _fromIcollectScopeInfos _fromIcounter _fromIkindErrors _fromImiscerrors _fromIself _fromIunboundNames _fromIwarnings) = inv_Expression_s41 _fromX41 (T_Expression_vIn40 _fromOallTypeConstructors _fromOallValueConstructors _fromOclassEnvironment _fromOcollectScopeInfos _fromOcounter _fromOkindErrors _fromOmiscerrors _fromOnamesInScope _fromOoptions _fromOorderedTypeSynonyms _fromOtypeConstructors _fromOvalueConstructors _fromOwarnings) + (T_MaybeExpression_vOut94 _thenIcollectInstances _thenIcollectScopeInfos _thenIcounter _thenIkindErrors _thenImiscerrors _thenIself _thenIunboundNames _thenIwarnings) = inv_MaybeExpression_s95 _thenX95 (T_MaybeExpression_vIn94 _thenOallTypeConstructors _thenOallValueConstructors _thenOclassEnvironment _thenOcollectScopeInfos _thenOcounter _thenOkindErrors _thenOmiscerrors _thenOnamesInScope _thenOoptions _thenOorderedTypeSynonyms _thenOtypeConstructors _thenOvalueConstructors _thenOwarnings) + (T_MaybeExpression_vOut94 _toIcollectInstances _toIcollectScopeInfos _toIcounter _toIkindErrors _toImiscerrors _toIself _toIunboundNames _toIwarnings) = inv_MaybeExpression_s95 _toX95 (T_MaybeExpression_vIn94 _toOallTypeConstructors _toOallValueConstructors _toOclassEnvironment _toOcollectScopeInfos _toOcounter _toOkindErrors _toOmiscerrors _toOnamesInScope _toOoptions _toOorderedTypeSynonyms _toOtypeConstructors _toOvalueConstructors _toOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1363 _fromIcollectInstances _thenIcollectInstances _toIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1364 _fromIunboundNames _thenIunboundNames _toIunboundNames + _self = rule1365 _fromIself _rangeIself _thenIself _toIself + _lhsOself :: Expression + _lhsOself = rule1366 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1367 _toIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1368 _toIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1369 _toIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1370 _toImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1371 _toIwarnings + _fromOallTypeConstructors = rule1372 _lhsIallTypeConstructors + _fromOallValueConstructors = rule1373 _lhsIallValueConstructors + _fromOclassEnvironment = rule1374 _lhsIclassEnvironment + _fromOcollectScopeInfos = rule1375 _lhsIcollectScopeInfos + _fromOcounter = rule1376 _lhsIcounter + _fromOkindErrors = rule1377 _lhsIkindErrors + _fromOmiscerrors = rule1378 _lhsImiscerrors + _fromOnamesInScope = rule1379 _lhsInamesInScope + _fromOoptions = rule1380 _lhsIoptions + _fromOorderedTypeSynonyms = rule1381 _lhsIorderedTypeSynonyms + _fromOtypeConstructors = rule1382 _lhsItypeConstructors + _fromOvalueConstructors = rule1383 _lhsIvalueConstructors + _fromOwarnings = rule1384 _lhsIwarnings + _thenOallTypeConstructors = rule1385 _lhsIallTypeConstructors + _thenOallValueConstructors = rule1386 _lhsIallValueConstructors + _thenOclassEnvironment = rule1387 _lhsIclassEnvironment + _thenOcollectScopeInfos = rule1388 _fromIcollectScopeInfos + _thenOcounter = rule1389 _fromIcounter + _thenOkindErrors = rule1390 _fromIkindErrors + _thenOmiscerrors = rule1391 _fromImiscerrors + _thenOnamesInScope = rule1392 _lhsInamesInScope + _thenOoptions = rule1393 _lhsIoptions + _thenOorderedTypeSynonyms = rule1394 _lhsIorderedTypeSynonyms + _thenOtypeConstructors = rule1395 _lhsItypeConstructors + _thenOvalueConstructors = rule1396 _lhsIvalueConstructors + _thenOwarnings = rule1397 _fromIwarnings + _toOallTypeConstructors = rule1398 _lhsIallTypeConstructors + _toOallValueConstructors = rule1399 _lhsIallValueConstructors + _toOclassEnvironment = rule1400 _lhsIclassEnvironment + _toOcollectScopeInfos = rule1401 _thenIcollectScopeInfos + _toOcounter = rule1402 _thenIcounter + _toOkindErrors = rule1403 _thenIkindErrors + _toOmiscerrors = rule1404 _thenImiscerrors + _toOnamesInScope = rule1405 _lhsInamesInScope + _toOoptions = rule1406 _lhsIoptions + _toOorderedTypeSynonyms = rule1407 _lhsIorderedTypeSynonyms + _toOtypeConstructors = rule1408 _lhsItypeConstructors + _toOvalueConstructors = rule1409 _lhsIvalueConstructors + _toOwarnings = rule1410 _thenIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1363 #-} + rule1363 = \ ((_fromIcollectInstances) :: [(Name, Instance)]) ((_thenIcollectInstances) :: [(Name, Instance)]) ((_toIcollectInstances) :: [(Name, Instance)]) -> + _fromIcollectInstances ++ _thenIcollectInstances ++ _toIcollectInstances + {-# INLINE rule1364 #-} + rule1364 = \ ((_fromIunboundNames) :: Names) ((_thenIunboundNames) :: Names) ((_toIunboundNames) :: Names) -> + _fromIunboundNames ++ _thenIunboundNames ++ _toIunboundNames + {-# INLINE rule1365 #-} + rule1365 = \ ((_fromIself) :: Expression) ((_rangeIself) :: Range) ((_thenIself) :: MaybeExpression) ((_toIself) :: MaybeExpression) -> + Expression_Enum _rangeIself _fromIself _thenIself _toIself + {-# INLINE rule1366 #-} + rule1366 = \ _self -> + _self + {-# INLINE rule1367 #-} + rule1367 = \ ((_toIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _toIcollectScopeInfos + {-# INLINE rule1368 #-} + rule1368 = \ ((_toIcounter) :: Int) -> + _toIcounter + {-# INLINE rule1369 #-} + rule1369 = \ ((_toIkindErrors) :: [Error]) -> + _toIkindErrors + {-# INLINE rule1370 #-} + rule1370 = \ ((_toImiscerrors) :: [Error]) -> + _toImiscerrors + {-# INLINE rule1371 #-} + rule1371 = \ ((_toIwarnings) :: [Warning]) -> + _toIwarnings + {-# INLINE rule1372 #-} + rule1372 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1373 #-} + rule1373 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1374 #-} + rule1374 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1375 #-} + rule1375 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1376 #-} + rule1376 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1377 #-} + rule1377 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1378 #-} + rule1378 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1379 #-} + rule1379 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1380 #-} + rule1380 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1381 #-} + rule1381 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1382 #-} + rule1382 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1383 #-} + rule1383 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1384 #-} + rule1384 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1385 #-} + rule1385 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1386 #-} + rule1386 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1387 #-} + rule1387 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1388 #-} + rule1388 = \ ((_fromIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _fromIcollectScopeInfos + {-# INLINE rule1389 #-} + rule1389 = \ ((_fromIcounter) :: Int) -> + _fromIcounter + {-# INLINE rule1390 #-} + rule1390 = \ ((_fromIkindErrors) :: [Error]) -> + _fromIkindErrors + {-# INLINE rule1391 #-} + rule1391 = \ ((_fromImiscerrors) :: [Error]) -> + _fromImiscerrors + {-# INLINE rule1392 #-} + rule1392 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1393 #-} + rule1393 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1394 #-} + rule1394 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1395 #-} + rule1395 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1396 #-} + rule1396 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1397 #-} + rule1397 = \ ((_fromIwarnings) :: [Warning]) -> + _fromIwarnings + {-# INLINE rule1398 #-} + rule1398 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1399 #-} + rule1399 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1400 #-} + rule1400 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1401 #-} + rule1401 = \ ((_thenIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _thenIcollectScopeInfos + {-# INLINE rule1402 #-} + rule1402 = \ ((_thenIcounter) :: Int) -> + _thenIcounter + {-# INLINE rule1403 #-} + rule1403 = \ ((_thenIkindErrors) :: [Error]) -> + _thenIkindErrors + {-# INLINE rule1404 #-} + rule1404 = \ ((_thenImiscerrors) :: [Error]) -> + _thenImiscerrors + {-# INLINE rule1405 #-} + rule1405 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1406 #-} + rule1406 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1407 #-} + rule1407 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1408 #-} + rule1408 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1409 #-} + rule1409 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1410 #-} + rule1410 = \ ((_thenIwarnings) :: [Warning]) -> + _thenIwarnings +{-# NOINLINE sem_Expression_Negate #-} +sem_Expression_Negate :: T_Range -> T_Expression -> T_Expression +sem_Expression_Negate arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1411 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1412 _expressionIunboundNames + _self = rule1413 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1414 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1415 _expressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1416 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1417 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1418 _expressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1419 _expressionIwarnings + _expressionOallTypeConstructors = rule1420 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule1421 _lhsIallValueConstructors + _expressionOclassEnvironment = rule1422 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule1423 _lhsIcollectScopeInfos + _expressionOcounter = rule1424 _lhsIcounter + _expressionOkindErrors = rule1425 _lhsIkindErrors + _expressionOmiscerrors = rule1426 _lhsImiscerrors + _expressionOnamesInScope = rule1427 _lhsInamesInScope + _expressionOoptions = rule1428 _lhsIoptions + _expressionOorderedTypeSynonyms = rule1429 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule1430 _lhsItypeConstructors + _expressionOvalueConstructors = rule1431 _lhsIvalueConstructors + _expressionOwarnings = rule1432 _lhsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1411 #-} + rule1411 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule1412 #-} + rule1412 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule1413 #-} + rule1413 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Negate _rangeIself _expressionIself + {-# INLINE rule1414 #-} + rule1414 = \ _self -> + _self + {-# INLINE rule1415 #-} + rule1415 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule1416 #-} + rule1416 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1417 #-} + rule1417 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule1418 #-} + rule1418 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule1419 #-} + rule1419 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule1420 #-} + rule1420 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1421 #-} + rule1421 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1422 #-} + rule1422 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1423 #-} + rule1423 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1424 #-} + rule1424 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1425 #-} + rule1425 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1426 #-} + rule1426 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1427 #-} + rule1427 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1428 #-} + rule1428 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1429 #-} + rule1429 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1430 #-} + rule1430 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1431 #-} + rule1431 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1432 #-} + rule1432 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Expression_NegateFloat #-} +sem_Expression_NegateFloat :: T_Range -> T_Expression -> T_Expression +sem_Expression_NegateFloat arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1433 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1434 _expressionIunboundNames + _self = rule1435 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule1436 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1437 _expressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1438 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1439 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1440 _expressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1441 _expressionIwarnings + _expressionOallTypeConstructors = rule1442 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule1443 _lhsIallValueConstructors + _expressionOclassEnvironment = rule1444 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule1445 _lhsIcollectScopeInfos + _expressionOcounter = rule1446 _lhsIcounter + _expressionOkindErrors = rule1447 _lhsIkindErrors + _expressionOmiscerrors = rule1448 _lhsImiscerrors + _expressionOnamesInScope = rule1449 _lhsInamesInScope + _expressionOoptions = rule1450 _lhsIoptions + _expressionOorderedTypeSynonyms = rule1451 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule1452 _lhsItypeConstructors + _expressionOvalueConstructors = rule1453 _lhsIvalueConstructors + _expressionOwarnings = rule1454 _lhsIwarnings + __result_ = T_Expression_vOut40 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule1433 #-} + rule1433 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule1434 #-} + rule1434 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule1435 #-} + rule1435 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NegateFloat _rangeIself _expressionIself + {-# INLINE rule1436 #-} + rule1436 = \ _self -> + _self + {-# INLINE rule1437 #-} + rule1437 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule1438 #-} + rule1438 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1439 #-} + rule1439 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule1440 #-} + rule1440 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule1441 #-} + rule1441 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule1442 #-} + rule1442 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1443 #-} + rule1443 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1444 #-} + rule1444 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1445 #-} + rule1445 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1446 #-} + rule1446 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1447 #-} + rule1447 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1448 #-} + rule1448 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1449 #-} + rule1449 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1450 #-} + rule1450 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1451 #-} + rule1451 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1452 #-} + rule1452 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1453 #-} + rule1453 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1454 #-} + rule1454 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Expressions ------------------------------------------------- +-- wrapper +data Inh_Expressions = Inh_Expressions { allTypeConstructors_Inh_Expressions :: (Names), allValueConstructors_Inh_Expressions :: (Names), classEnvironment_Inh_Expressions :: (ClassEnvironment), collectScopeInfos_Inh_Expressions :: ([(ScopeInfo, Entity)]), counter_Inh_Expressions :: (Int), kindErrors_Inh_Expressions :: ([Error]), miscerrors_Inh_Expressions :: ([Error]), namesInScope_Inh_Expressions :: (Names), options_Inh_Expressions :: ([Option]), orderedTypeSynonyms_Inh_Expressions :: (OrderedTypeSynonyms), typeConstructors_Inh_Expressions :: (M.Map Name Int), valueConstructors_Inh_Expressions :: (M.Map Name TpScheme), warnings_Inh_Expressions :: ([Warning]) } +data Syn_Expressions = Syn_Expressions { collectInstances_Syn_Expressions :: ([(Name, Instance)]), collectScopeInfos_Syn_Expressions :: ([(ScopeInfo, Entity)]), counter_Syn_Expressions :: (Int), kindErrors_Syn_Expressions :: ([Error]), miscerrors_Syn_Expressions :: ([Error]), self_Syn_Expressions :: (Expressions), unboundNames_Syn_Expressions :: (Names), warnings_Syn_Expressions :: ([Warning]) } +{-# INLINABLE wrap_Expressions #-} +wrap_Expressions :: T_Expressions -> Inh_Expressions -> (Syn_Expressions ) +wrap_Expressions (T_Expressions act) (Inh_Expressions _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expressions_vIn43 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_Expressions_vOut43 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_Expressions_s44 sem arg) + return (Syn_Expressions _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Expressions #-} +sem_Expressions :: Expressions -> T_Expressions +sem_Expressions list = Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list) + +-- semantic domain +newtype T_Expressions = T_Expressions { + attach_T_Expressions :: Identity (T_Expressions_s44 ) + } +newtype T_Expressions_s44 = C_Expressions_s44 { + inv_Expressions_s44 :: (T_Expressions_v43 ) + } +data T_Expressions_s45 = C_Expressions_s45 +type T_Expressions_v43 = (T_Expressions_vIn43 ) -> (T_Expressions_vOut43 ) +data T_Expressions_vIn43 = T_Expressions_vIn43 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_Expressions_vOut43 = T_Expressions_vOut43 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Expressions) (Names) ([Warning]) +{-# NOINLINE sem_Expressions_Cons #-} +sem_Expressions_Cons :: T_Expression -> T_Expressions -> T_Expressions +sem_Expressions_Cons arg_hd_ arg_tl_ = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_hd_)) + _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_tl_)) + (T_Expression_vOut40 _hdIcollectInstances _hdIcollectScopeInfos _hdIcounter _hdIkindErrors _hdImiscerrors _hdIself _hdIunboundNames _hdIwarnings) = inv_Expression_s41 _hdX41 (T_Expression_vIn40 _hdOallTypeConstructors _hdOallValueConstructors _hdOclassEnvironment _hdOcollectScopeInfos _hdOcounter _hdOkindErrors _hdOmiscerrors _hdOnamesInScope _hdOoptions _hdOorderedTypeSynonyms _hdOtypeConstructors _hdOvalueConstructors _hdOwarnings) + (T_Expressions_vOut43 _tlIcollectInstances _tlIcollectScopeInfos _tlIcounter _tlIkindErrors _tlImiscerrors _tlIself _tlIunboundNames _tlIwarnings) = inv_Expressions_s44 _tlX44 (T_Expressions_vIn43 _tlOallTypeConstructors _tlOallValueConstructors _tlOclassEnvironment _tlOcollectScopeInfos _tlOcounter _tlOkindErrors _tlOmiscerrors _tlOnamesInScope _tlOoptions _tlOorderedTypeSynonyms _tlOtypeConstructors _tlOvalueConstructors _tlOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1455 _hdIcollectInstances _tlIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1456 _hdIunboundNames _tlIunboundNames + _self = rule1457 _hdIself _tlIself + _lhsOself :: Expressions + _lhsOself = rule1458 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1459 _tlIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1460 _tlIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1461 _tlIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1462 _tlImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1463 _tlIwarnings + _hdOallTypeConstructors = rule1464 _lhsIallTypeConstructors + _hdOallValueConstructors = rule1465 _lhsIallValueConstructors + _hdOclassEnvironment = rule1466 _lhsIclassEnvironment + _hdOcollectScopeInfos = rule1467 _lhsIcollectScopeInfos + _hdOcounter = rule1468 _lhsIcounter + _hdOkindErrors = rule1469 _lhsIkindErrors + _hdOmiscerrors = rule1470 _lhsImiscerrors + _hdOnamesInScope = rule1471 _lhsInamesInScope + _hdOoptions = rule1472 _lhsIoptions + _hdOorderedTypeSynonyms = rule1473 _lhsIorderedTypeSynonyms + _hdOtypeConstructors = rule1474 _lhsItypeConstructors + _hdOvalueConstructors = rule1475 _lhsIvalueConstructors + _hdOwarnings = rule1476 _lhsIwarnings + _tlOallTypeConstructors = rule1477 _lhsIallTypeConstructors + _tlOallValueConstructors = rule1478 _lhsIallValueConstructors + _tlOclassEnvironment = rule1479 _lhsIclassEnvironment + _tlOcollectScopeInfos = rule1480 _hdIcollectScopeInfos + _tlOcounter = rule1481 _hdIcounter + _tlOkindErrors = rule1482 _hdIkindErrors + _tlOmiscerrors = rule1483 _hdImiscerrors + _tlOnamesInScope = rule1484 _lhsInamesInScope + _tlOoptions = rule1485 _lhsIoptions + _tlOorderedTypeSynonyms = rule1486 _lhsIorderedTypeSynonyms + _tlOtypeConstructors = rule1487 _lhsItypeConstructors + _tlOvalueConstructors = rule1488 _lhsIvalueConstructors + _tlOwarnings = rule1489 _hdIwarnings + __result_ = T_Expressions_vOut43 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule1455 #-} + rule1455 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule1456 #-} + rule1456 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule1457 #-} + rule1457 = \ ((_hdIself) :: Expression) ((_tlIself) :: Expressions) -> + (:) _hdIself _tlIself + {-# INLINE rule1458 #-} + rule1458 = \ _self -> + _self + {-# INLINE rule1459 #-} + rule1459 = \ ((_tlIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _tlIcollectScopeInfos + {-# INLINE rule1460 #-} + rule1460 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule1461 #-} + rule1461 = \ ((_tlIkindErrors) :: [Error]) -> + _tlIkindErrors + {-# INLINE rule1462 #-} + rule1462 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule1463 #-} + rule1463 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule1464 #-} + rule1464 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1465 #-} + rule1465 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1466 #-} + rule1466 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1467 #-} + rule1467 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1468 #-} + rule1468 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1469 #-} + rule1469 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1470 #-} + rule1470 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1471 #-} + rule1471 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1472 #-} + rule1472 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1473 #-} + rule1473 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1474 #-} + rule1474 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1475 #-} + rule1475 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1476 #-} + rule1476 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1477 #-} + rule1477 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1478 #-} + rule1478 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1479 #-} + rule1479 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1480 #-} + rule1480 = \ ((_hdIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _hdIcollectScopeInfos + {-# INLINE rule1481 #-} + rule1481 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule1482 #-} + rule1482 = \ ((_hdIkindErrors) :: [Error]) -> + _hdIkindErrors + {-# INLINE rule1483 #-} + rule1483 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule1484 #-} + rule1484 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1485 #-} + rule1485 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1486 #-} + rule1486 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1487 #-} + rule1487 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1488 #-} + rule1488 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1489 #-} + rule1489 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_Expressions_Nil #-} +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1490 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1491 () + _self = rule1492 () + _lhsOself :: Expressions + _lhsOself = rule1493 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1494 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1495 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1496 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1497 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1498 _lhsIwarnings + __result_ = T_Expressions_vOut43 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule1490 #-} + rule1490 = \ (_ :: ()) -> + [] + {-# INLINE rule1491 #-} + rule1491 = \ (_ :: ()) -> + [] + {-# INLINE rule1492 #-} + rule1492 = \ (_ :: ()) -> + [] + {-# INLINE rule1493 #-} + rule1493 = \ _self -> + _self + {-# INLINE rule1494 #-} + rule1494 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1495 #-} + rule1495 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1496 #-} + rule1496 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1497 #-} + rule1497 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1498 #-} + rule1498 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- FieldDeclaration -------------------------------------------- +-- wrapper +data Inh_FieldDeclaration = Inh_FieldDeclaration { counter_Inh_FieldDeclaration :: (Int), miscerrors_Inh_FieldDeclaration :: ([Error]), namesInScope_Inh_FieldDeclaration :: (Names), options_Inh_FieldDeclaration :: ([Option]) } +data Syn_FieldDeclaration = Syn_FieldDeclaration { counter_Syn_FieldDeclaration :: (Int), miscerrors_Syn_FieldDeclaration :: ([Error]), self_Syn_FieldDeclaration :: (FieldDeclaration), unboundNames_Syn_FieldDeclaration :: (Names) } +{-# INLINABLE wrap_FieldDeclaration #-} +wrap_FieldDeclaration :: T_FieldDeclaration -> Inh_FieldDeclaration -> (Syn_FieldDeclaration ) +wrap_FieldDeclaration (T_FieldDeclaration act) (Inh_FieldDeclaration _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsIoptions) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclaration_vIn46 _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsIoptions + (T_FieldDeclaration_vOut46 _lhsOcounter _lhsOmiscerrors _lhsOself _lhsOunboundNames) <- return (inv_FieldDeclaration_s47 sem arg) + return (Syn_FieldDeclaration _lhsOcounter _lhsOmiscerrors _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# INLINE sem_FieldDeclaration #-} +sem_FieldDeclaration :: FieldDeclaration -> T_FieldDeclaration +sem_FieldDeclaration ( FieldDeclaration_FieldDeclaration range_ names_ type_ ) = sem_FieldDeclaration_FieldDeclaration ( sem_Range range_ ) ( sem_Names names_ ) ( sem_AnnotatedType type_ ) + +-- semantic domain +newtype T_FieldDeclaration = T_FieldDeclaration { + attach_T_FieldDeclaration :: Identity (T_FieldDeclaration_s47 ) + } +newtype T_FieldDeclaration_s47 = C_FieldDeclaration_s47 { + inv_FieldDeclaration_s47 :: (T_FieldDeclaration_v46 ) + } +data T_FieldDeclaration_s48 = C_FieldDeclaration_s48 +type T_FieldDeclaration_v46 = (T_FieldDeclaration_vIn46 ) -> (T_FieldDeclaration_vOut46 ) +data T_FieldDeclaration_vIn46 = T_FieldDeclaration_vIn46 (Int) ([Error]) (Names) ([Option]) +data T_FieldDeclaration_vOut46 = T_FieldDeclaration_vOut46 (Int) ([Error]) (FieldDeclaration) (Names) +{-# NOINLINE sem_FieldDeclaration_FieldDeclaration #-} +sem_FieldDeclaration_FieldDeclaration :: T_Range -> T_Names -> T_AnnotatedType -> T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration arg_range_ arg_names_ arg_type_ = T_FieldDeclaration (return st47) where + {-# NOINLINE st47 #-} + st47 = let + v46 :: T_FieldDeclaration_v46 + v46 = \ (T_FieldDeclaration_vIn46 _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsIoptions) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_AnnotatedType_vOut7 _typeIcounter _typeIkindErrors _typeImiscerrors _typeIself _typeItype _typeItypevariables _typeIunboundNames _typeIwarnings) = inv_AnnotatedType_s8 _typeX8 (T_AnnotatedType_vIn7 _typeOallTypeConstructors _typeOallValueConstructors _typeOcounter _typeOkindErrors _typeOmiscerrors _typeOnamesInScope _typeOoptions _typeOtypeConstructors _typeOvalueConstructors _typeOwarnings) + (_kindErrors,_tyconEnv,_constructorenv,_importEnvironment,_valueConstructors,_allValueConstructors,_typeConstructors,_allTypeConstructors,_warnings) = rule1499 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1500 _typeIunboundNames + _self = rule1501 _namesIself _rangeIself _typeIself + _lhsOself :: FieldDeclaration + _lhsOself = rule1502 _self + _lhsOcounter :: Int + _lhsOcounter = rule1503 _typeIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1504 _typeImiscerrors + _typeOallTypeConstructors = rule1505 _allTypeConstructors + _typeOallValueConstructors = rule1506 _allValueConstructors + _typeOcounter = rule1507 _lhsIcounter + _typeOkindErrors = rule1508 _kindErrors + _typeOmiscerrors = rule1509 _lhsImiscerrors + _typeOnamesInScope = rule1510 _lhsInamesInScope + _typeOoptions = rule1511 _lhsIoptions + _typeOtypeConstructors = rule1512 _typeConstructors + _typeOvalueConstructors = rule1513 _valueConstructors + _typeOwarnings = rule1514 _warnings + __result_ = T_FieldDeclaration_vOut46 _lhsOcounter _lhsOmiscerrors _lhsOself _lhsOunboundNames + in __result_ ) + in C_FieldDeclaration_s47 v46 + {-# INLINE rule1499 #-} + rule1499 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "FieldDeclaration.FieldDeclaration" + {-# INLINE rule1500 #-} + rule1500 = \ ((_typeIunboundNames) :: Names) -> + _typeIunboundNames + {-# INLINE rule1501 #-} + rule1501 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: AnnotatedType) -> + FieldDeclaration_FieldDeclaration _rangeIself _namesIself _typeIself + {-# INLINE rule1502 #-} + rule1502 = \ _self -> + _self + {-# INLINE rule1503 #-} + rule1503 = \ ((_typeIcounter) :: Int) -> + _typeIcounter + {-# INLINE rule1504 #-} + rule1504 = \ ((_typeImiscerrors) :: [Error]) -> + _typeImiscerrors + {-# INLINE rule1505 #-} + rule1505 = \ _allTypeConstructors -> + _allTypeConstructors + {-# INLINE rule1506 #-} + rule1506 = \ _allValueConstructors -> + _allValueConstructors + {-# INLINE rule1507 #-} + rule1507 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1508 #-} + rule1508 = \ _kindErrors -> + _kindErrors + {-# INLINE rule1509 #-} + rule1509 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1510 #-} + rule1510 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1511 #-} + rule1511 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1512 #-} + rule1512 = \ _typeConstructors -> + _typeConstructors + {-# INLINE rule1513 #-} + rule1513 = \ _valueConstructors -> + _valueConstructors + {-# INLINE rule1514 #-} + rule1514 = \ _warnings -> + _warnings + +-- FieldDeclarations ------------------------------------------- +-- wrapper +data Inh_FieldDeclarations = Inh_FieldDeclarations { counter_Inh_FieldDeclarations :: (Int), miscerrors_Inh_FieldDeclarations :: ([Error]), namesInScope_Inh_FieldDeclarations :: (Names), options_Inh_FieldDeclarations :: ([Option]) } +data Syn_FieldDeclarations = Syn_FieldDeclarations { counter_Syn_FieldDeclarations :: (Int), miscerrors_Syn_FieldDeclarations :: ([Error]), self_Syn_FieldDeclarations :: (FieldDeclarations), unboundNames_Syn_FieldDeclarations :: (Names) } +{-# INLINABLE wrap_FieldDeclarations #-} +wrap_FieldDeclarations :: T_FieldDeclarations -> Inh_FieldDeclarations -> (Syn_FieldDeclarations ) +wrap_FieldDeclarations (T_FieldDeclarations act) (Inh_FieldDeclarations _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsIoptions) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclarations_vIn49 _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsIoptions + (T_FieldDeclarations_vOut49 _lhsOcounter _lhsOmiscerrors _lhsOself _lhsOunboundNames) <- return (inv_FieldDeclarations_s50 sem arg) + return (Syn_FieldDeclarations _lhsOcounter _lhsOmiscerrors _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_FieldDeclarations #-} +sem_FieldDeclarations :: FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations list = Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list) + +-- semantic domain +newtype T_FieldDeclarations = T_FieldDeclarations { + attach_T_FieldDeclarations :: Identity (T_FieldDeclarations_s50 ) + } +newtype T_FieldDeclarations_s50 = C_FieldDeclarations_s50 { + inv_FieldDeclarations_s50 :: (T_FieldDeclarations_v49 ) + } +data T_FieldDeclarations_s51 = C_FieldDeclarations_s51 +type T_FieldDeclarations_v49 = (T_FieldDeclarations_vIn49 ) -> (T_FieldDeclarations_vOut49 ) +data T_FieldDeclarations_vIn49 = T_FieldDeclarations_vIn49 (Int) ([Error]) (Names) ([Option]) +data T_FieldDeclarations_vOut49 = T_FieldDeclarations_vOut49 (Int) ([Error]) (FieldDeclarations) (Names) +{-# NOINLINE sem_FieldDeclarations_Cons #-} +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> T_FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations_Cons arg_hd_ arg_tl_ = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsIoptions) -> ( let + _hdX47 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclaration (arg_hd_)) + _tlX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_tl_)) + (T_FieldDeclaration_vOut46 _hdIcounter _hdImiscerrors _hdIself _hdIunboundNames) = inv_FieldDeclaration_s47 _hdX47 (T_FieldDeclaration_vIn46 _hdOcounter _hdOmiscerrors _hdOnamesInScope _hdOoptions) + (T_FieldDeclarations_vOut49 _tlIcounter _tlImiscerrors _tlIself _tlIunboundNames) = inv_FieldDeclarations_s50 _tlX50 (T_FieldDeclarations_vIn49 _tlOcounter _tlOmiscerrors _tlOnamesInScope _tlOoptions) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1515 _hdIunboundNames _tlIunboundNames + _self = rule1516 _hdIself _tlIself + _lhsOself :: FieldDeclarations + _lhsOself = rule1517 _self + _lhsOcounter :: Int + _lhsOcounter = rule1518 _tlIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1519 _tlImiscerrors + _hdOcounter = rule1520 _lhsIcounter + _hdOmiscerrors = rule1521 _lhsImiscerrors + _hdOnamesInScope = rule1522 _lhsInamesInScope + _hdOoptions = rule1523 _lhsIoptions + _tlOcounter = rule1524 _hdIcounter + _tlOmiscerrors = rule1525 _hdImiscerrors + _tlOnamesInScope = rule1526 _lhsInamesInScope + _tlOoptions = rule1527 _lhsIoptions + __result_ = T_FieldDeclarations_vOut49 _lhsOcounter _lhsOmiscerrors _lhsOself _lhsOunboundNames + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule1515 #-} + rule1515 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule1516 #-} + rule1516 = \ ((_hdIself) :: FieldDeclaration) ((_tlIself) :: FieldDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule1517 #-} + rule1517 = \ _self -> + _self + {-# INLINE rule1518 #-} + rule1518 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule1519 #-} + rule1519 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule1520 #-} + rule1520 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1521 #-} + rule1521 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1522 #-} + rule1522 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1523 #-} + rule1523 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1524 #-} + rule1524 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule1525 #-} + rule1525 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule1526 #-} + rule1526 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1527 #-} + rule1527 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions +{-# NOINLINE sem_FieldDeclarations_Nil #-} +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsIoptions) -> ( let + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1528 () + _self = rule1529 () + _lhsOself :: FieldDeclarations + _lhsOself = rule1530 _self + _lhsOcounter :: Int + _lhsOcounter = rule1531 _lhsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1532 _lhsImiscerrors + __result_ = T_FieldDeclarations_vOut49 _lhsOcounter _lhsOmiscerrors _lhsOself _lhsOunboundNames + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule1528 #-} + rule1528 = \ (_ :: ()) -> + [] + {-# INLINE rule1529 #-} + rule1529 = \ (_ :: ()) -> + [] + {-# INLINE rule1530 #-} + rule1530 = \ _self -> + _self + {-# INLINE rule1531 #-} + rule1531 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1532 #-} + rule1532 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + +-- Fixity ------------------------------------------------------ +-- wrapper +data Inh_Fixity = Inh_Fixity { } +data Syn_Fixity = Syn_Fixity { self_Syn_Fixity :: (Fixity) } +{-# INLINABLE wrap_Fixity #-} +wrap_Fixity :: T_Fixity -> Inh_Fixity -> (Syn_Fixity ) +wrap_Fixity (T_Fixity act) (Inh_Fixity ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Fixity_vIn52 + (T_Fixity_vOut52 _lhsOself) <- return (inv_Fixity_s53 sem arg) + return (Syn_Fixity _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Fixity #-} +sem_Fixity :: Fixity -> T_Fixity +sem_Fixity ( Fixity_Infixl range_ ) = sem_Fixity_Infixl ( sem_Range range_ ) +sem_Fixity ( Fixity_Infixr range_ ) = sem_Fixity_Infixr ( sem_Range range_ ) +sem_Fixity ( Fixity_Infix range_ ) = sem_Fixity_Infix ( sem_Range range_ ) + +-- semantic domain +newtype T_Fixity = T_Fixity { + attach_T_Fixity :: Identity (T_Fixity_s53 ) + } +newtype T_Fixity_s53 = C_Fixity_s53 { + inv_Fixity_s53 :: (T_Fixity_v52 ) + } +data T_Fixity_s54 = C_Fixity_s54 +type T_Fixity_v52 = (T_Fixity_vIn52 ) -> (T_Fixity_vOut52 ) +data T_Fixity_vIn52 = T_Fixity_vIn52 +data T_Fixity_vOut52 = T_Fixity_vOut52 (Fixity) +{-# NOINLINE sem_Fixity_Infixl #-} +sem_Fixity_Infixl :: T_Range -> T_Fixity +sem_Fixity_Infixl arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule1533 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule1534 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule1533 #-} + rule1533 = \ ((_rangeIself) :: Range) -> + Fixity_Infixl _rangeIself + {-# INLINE rule1534 #-} + rule1534 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infixr #-} +sem_Fixity_Infixr :: T_Range -> T_Fixity +sem_Fixity_Infixr arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule1535 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule1536 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule1535 #-} + rule1535 = \ ((_rangeIself) :: Range) -> + Fixity_Infixr _rangeIself + {-# INLINE rule1536 #-} + rule1536 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infix #-} +sem_Fixity_Infix :: T_Range -> T_Fixity +sem_Fixity_Infix arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule1537 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule1538 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule1537 #-} + rule1537 = \ ((_rangeIself) :: Range) -> + Fixity_Infix _rangeIself + {-# INLINE rule1538 #-} + rule1538 = \ _self -> + _self + +-- FunctionBinding --------------------------------------------- +-- wrapper +data Inh_FunctionBinding = Inh_FunctionBinding { allTypeConstructors_Inh_FunctionBinding :: (Names), allValueConstructors_Inh_FunctionBinding :: (Names), classEnvironment_Inh_FunctionBinding :: (ClassEnvironment), collectScopeInfos_Inh_FunctionBinding :: ([(ScopeInfo, Entity)]), counter_Inh_FunctionBinding :: (Int), kindErrors_Inh_FunctionBinding :: ([Error]), miscerrors_Inh_FunctionBinding :: ([Error]), namesInScope_Inh_FunctionBinding :: (Names), options_Inh_FunctionBinding :: ([Option]), orderedTypeSynonyms_Inh_FunctionBinding :: (OrderedTypeSynonyms), typeConstructors_Inh_FunctionBinding :: (M.Map Name Int), valueConstructors_Inh_FunctionBinding :: (M.Map Name TpScheme), warnings_Inh_FunctionBinding :: ([Warning]) } +data Syn_FunctionBinding = Syn_FunctionBinding { arity_Syn_FunctionBinding :: (Int), collectInstances_Syn_FunctionBinding :: ([(Name, Instance)]), collectScopeInfos_Syn_FunctionBinding :: ([(ScopeInfo, Entity)]), counter_Syn_FunctionBinding :: (Int), kindErrors_Syn_FunctionBinding :: ([Error]), miscerrors_Syn_FunctionBinding :: ([Error]), name_Syn_FunctionBinding :: (Name), self_Syn_FunctionBinding :: (FunctionBinding), unboundNames_Syn_FunctionBinding :: (Names), warnings_Syn_FunctionBinding :: ([Warning]) } +{-# INLINABLE wrap_FunctionBinding #-} +wrap_FunctionBinding :: T_FunctionBinding -> Inh_FunctionBinding -> (Syn_FunctionBinding ) +wrap_FunctionBinding (T_FunctionBinding act) (Inh_FunctionBinding _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBinding_vIn55 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_FunctionBinding_vOut55 _lhsOarity _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOname _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_FunctionBinding_s56 sem arg) + return (Syn_FunctionBinding _lhsOarity _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOname _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_FunctionBinding #-} +sem_FunctionBinding :: FunctionBinding -> T_FunctionBinding +sem_FunctionBinding ( FunctionBinding_Hole range_ id_ ) = sem_FunctionBinding_Hole ( sem_Range range_ ) id_ +sem_FunctionBinding ( FunctionBinding_Feedback range_ feedback_ functionBinding_ ) = sem_FunctionBinding_Feedback ( sem_Range range_ ) feedback_ ( sem_FunctionBinding functionBinding_ ) +sem_FunctionBinding ( FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ ) = sem_FunctionBinding_FunctionBinding ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_RightHandSide righthandside_ ) + +-- semantic domain +newtype T_FunctionBinding = T_FunctionBinding { + attach_T_FunctionBinding :: Identity (T_FunctionBinding_s56 ) + } +newtype T_FunctionBinding_s56 = C_FunctionBinding_s56 { + inv_FunctionBinding_s56 :: (T_FunctionBinding_v55 ) + } +data T_FunctionBinding_s57 = C_FunctionBinding_s57 +type T_FunctionBinding_v55 = (T_FunctionBinding_vIn55 ) -> (T_FunctionBinding_vOut55 ) +data T_FunctionBinding_vIn55 = T_FunctionBinding_vIn55 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_FunctionBinding_vOut55 = T_FunctionBinding_vOut55 (Int) ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Name) (FunctionBinding) (Names) ([Warning]) +{-# NOINLINE sem_FunctionBinding_Hole #-} +sem_FunctionBinding_Hole :: T_Range -> (Integer) -> T_FunctionBinding +sem_FunctionBinding_Hole arg_range_ arg_id_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOname :: Name + _lhsOname = rule1539 () + _lhsOarity :: Int + _lhsOarity = rule1540 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1541 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1542 () + _self = rule1543 _rangeIself arg_id_ + _lhsOself :: FunctionBinding + _lhsOself = rule1544 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1545 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1546 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1547 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1548 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1549 _lhsIwarnings + __result_ = T_FunctionBinding_vOut55 _lhsOarity _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOname _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule1539 #-} + rule1539 = \ (_ :: ()) -> + internalError "StaticChecks.ag" "n/a" "empty FunctionBindings" + {-# INLINE rule1540 #-} + rule1540 = \ (_ :: ()) -> + 0 + {-# INLINE rule1541 #-} + rule1541 = \ (_ :: ()) -> + [] + {-# INLINE rule1542 #-} + rule1542 = \ (_ :: ()) -> + [] + {-# INLINE rule1543 #-} + rule1543 = \ ((_rangeIself) :: Range) id_ -> + FunctionBinding_Hole _rangeIself id_ + {-# INLINE rule1544 #-} + rule1544 = \ _self -> + _self + {-# INLINE rule1545 #-} + rule1545 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1546 #-} + rule1546 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1547 #-} + rule1547 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1548 #-} + rule1548 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1549 #-} + rule1549 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_FunctionBinding_Feedback #-} +sem_FunctionBinding_Feedback :: T_Range -> (String) -> T_FunctionBinding -> T_FunctionBinding +sem_FunctionBinding_Feedback arg_range_ arg_feedback_ arg_functionBinding_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionBindingX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_functionBinding_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBinding_vOut55 _functionBindingIarity _functionBindingIcollectInstances _functionBindingIcollectScopeInfos _functionBindingIcounter _functionBindingIkindErrors _functionBindingImiscerrors _functionBindingIname _functionBindingIself _functionBindingIunboundNames _functionBindingIwarnings) = inv_FunctionBinding_s56 _functionBindingX56 (T_FunctionBinding_vIn55 _functionBindingOallTypeConstructors _functionBindingOallValueConstructors _functionBindingOclassEnvironment _functionBindingOcollectScopeInfos _functionBindingOcounter _functionBindingOkindErrors _functionBindingOmiscerrors _functionBindingOnamesInScope _functionBindingOoptions _functionBindingOorderedTypeSynonyms _functionBindingOtypeConstructors _functionBindingOvalueConstructors _functionBindingOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1550 _functionBindingIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1551 _functionBindingIunboundNames + _self = rule1552 _functionBindingIself _rangeIself arg_feedback_ + _lhsOself :: FunctionBinding + _lhsOself = rule1553 _self + _lhsOarity :: Int + _lhsOarity = rule1554 _functionBindingIarity + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1555 _functionBindingIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1556 _functionBindingIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1557 _functionBindingIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1558 _functionBindingImiscerrors + _lhsOname :: Name + _lhsOname = rule1559 _functionBindingIname + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1560 _functionBindingIwarnings + _functionBindingOallTypeConstructors = rule1561 _lhsIallTypeConstructors + _functionBindingOallValueConstructors = rule1562 _lhsIallValueConstructors + _functionBindingOclassEnvironment = rule1563 _lhsIclassEnvironment + _functionBindingOcollectScopeInfos = rule1564 _lhsIcollectScopeInfos + _functionBindingOcounter = rule1565 _lhsIcounter + _functionBindingOkindErrors = rule1566 _lhsIkindErrors + _functionBindingOmiscerrors = rule1567 _lhsImiscerrors + _functionBindingOnamesInScope = rule1568 _lhsInamesInScope + _functionBindingOoptions = rule1569 _lhsIoptions + _functionBindingOorderedTypeSynonyms = rule1570 _lhsIorderedTypeSynonyms + _functionBindingOtypeConstructors = rule1571 _lhsItypeConstructors + _functionBindingOvalueConstructors = rule1572 _lhsIvalueConstructors + _functionBindingOwarnings = rule1573 _lhsIwarnings + __result_ = T_FunctionBinding_vOut55 _lhsOarity _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOname _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule1550 #-} + rule1550 = \ ((_functionBindingIcollectInstances) :: [(Name, Instance)]) -> + _functionBindingIcollectInstances + {-# INLINE rule1551 #-} + rule1551 = \ ((_functionBindingIunboundNames) :: Names) -> + _functionBindingIunboundNames + {-# INLINE rule1552 #-} + rule1552 = \ ((_functionBindingIself) :: FunctionBinding) ((_rangeIself) :: Range) feedback_ -> + FunctionBinding_Feedback _rangeIself feedback_ _functionBindingIself + {-# INLINE rule1553 #-} + rule1553 = \ _self -> + _self + {-# INLINE rule1554 #-} + rule1554 = \ ((_functionBindingIarity) :: Int) -> + _functionBindingIarity + {-# INLINE rule1555 #-} + rule1555 = \ ((_functionBindingIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _functionBindingIcollectScopeInfos + {-# INLINE rule1556 #-} + rule1556 = \ ((_functionBindingIcounter) :: Int) -> + _functionBindingIcounter + {-# INLINE rule1557 #-} + rule1557 = \ ((_functionBindingIkindErrors) :: [Error]) -> + _functionBindingIkindErrors + {-# INLINE rule1558 #-} + rule1558 = \ ((_functionBindingImiscerrors) :: [Error]) -> + _functionBindingImiscerrors + {-# INLINE rule1559 #-} + rule1559 = \ ((_functionBindingIname) :: Name) -> + _functionBindingIname + {-# INLINE rule1560 #-} + rule1560 = \ ((_functionBindingIwarnings) :: [Warning]) -> + _functionBindingIwarnings + {-# INLINE rule1561 #-} + rule1561 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1562 #-} + rule1562 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1563 #-} + rule1563 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1564 #-} + rule1564 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1565 #-} + rule1565 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1566 #-} + rule1566 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1567 #-} + rule1567 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1568 #-} + rule1568 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1569 #-} + rule1569 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1570 #-} + rule1570 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1571 #-} + rule1571 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1572 #-} + rule1572 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1573 #-} + rule1573 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_FunctionBinding_FunctionBinding #-} +sem_FunctionBinding_FunctionBinding :: T_Range -> T_LeftHandSide -> T_RightHandSide -> T_FunctionBinding +sem_FunctionBinding_FunctionBinding arg_range_ arg_lefthandside_ arg_righthandside_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIcollectScopeInfos _lefthandsideIcounter _lefthandsideImiscerrors _lefthandsideIname _lefthandsideInumberOfPatterns _lefthandsideIpatVarNames _lefthandsideIself _lefthandsideIunboundNames _lefthandsideIwarnings) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 _lefthandsideOallTypeConstructors _lefthandsideOallValueConstructors _lefthandsideOcollectScopeInfos _lefthandsideOcounter _lefthandsideOmiscerrors _lefthandsideOnamesInScope _lefthandsideOtypeConstructors _lefthandsideOvalueConstructors _lefthandsideOwarnings) + (T_RightHandSide_vOut148 _righthandsideIcollectInstances _righthandsideIcollectScopeInfos _righthandsideIcounter _righthandsideIkindErrors _righthandsideImiscerrors _righthandsideIself _righthandsideIunboundNames _righthandsideIwarnings) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 _righthandsideOallTypeConstructors _righthandsideOallValueConstructors _righthandsideOclassEnvironment _righthandsideOcollectScopeInfos _righthandsideOcounter _righthandsideOkindErrors _righthandsideOmiscerrors _righthandsideOnamesInScope _righthandsideOoptions _righthandsideOorderedTypeSynonyms _righthandsideOtypeConstructors _righthandsideOvalueConstructors _righthandsideOwarnings) + (_namesInScope,_unboundNames,_scopeInfo) = rule1574 _lefthandsideIpatVarNames _lhsInamesInScope _righthandsideIunboundNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1575 _unboundNames + _lhsOarity :: Int + _lhsOarity = rule1576 _lefthandsideInumberOfPatterns + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1577 _righthandsideIcollectScopeInfos _scopeInfo + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1578 _righthandsideIcollectInstances + _self = rule1579 _lefthandsideIself _rangeIself _righthandsideIself + _lhsOself :: FunctionBinding + _lhsOself = rule1580 _self + _lhsOcounter :: Int + _lhsOcounter = rule1581 _righthandsideIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1582 _righthandsideIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1583 _righthandsideImiscerrors + _lhsOname :: Name + _lhsOname = rule1584 _lefthandsideIname + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1585 _righthandsideIwarnings + _lefthandsideOallTypeConstructors = rule1586 _lhsIallTypeConstructors + _lefthandsideOallValueConstructors = rule1587 _lhsIallValueConstructors + _lefthandsideOcollectScopeInfos = rule1588 _lhsIcollectScopeInfos + _lefthandsideOcounter = rule1589 _lhsIcounter + _lefthandsideOmiscerrors = rule1590 _lhsImiscerrors + _lefthandsideOnamesInScope = rule1591 _namesInScope + _lefthandsideOtypeConstructors = rule1592 _lhsItypeConstructors + _lefthandsideOvalueConstructors = rule1593 _lhsIvalueConstructors + _lefthandsideOwarnings = rule1594 _lhsIwarnings + _righthandsideOallTypeConstructors = rule1595 _lhsIallTypeConstructors + _righthandsideOallValueConstructors = rule1596 _lhsIallValueConstructors + _righthandsideOclassEnvironment = rule1597 _lhsIclassEnvironment + _righthandsideOcollectScopeInfos = rule1598 _lefthandsideIcollectScopeInfos + _righthandsideOcounter = rule1599 _lefthandsideIcounter + _righthandsideOkindErrors = rule1600 _lhsIkindErrors + _righthandsideOmiscerrors = rule1601 _lefthandsideImiscerrors + _righthandsideOnamesInScope = rule1602 _namesInScope + _righthandsideOoptions = rule1603 _lhsIoptions + _righthandsideOorderedTypeSynonyms = rule1604 _lhsIorderedTypeSynonyms + _righthandsideOtypeConstructors = rule1605 _lhsItypeConstructors + _righthandsideOvalueConstructors = rule1606 _lhsIvalueConstructors + _righthandsideOwarnings = rule1607 _lefthandsideIwarnings + __result_ = T_FunctionBinding_vOut55 _lhsOarity _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOname _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule1574 #-} + rule1574 = \ ((_lefthandsideIpatVarNames) :: Names) ((_lhsInamesInScope) :: Names) ((_righthandsideIunboundNames) :: Names) -> + changeOfScope _lefthandsideIpatVarNames _righthandsideIunboundNames _lhsInamesInScope + {-# INLINE rule1575 #-} + rule1575 = \ _unboundNames -> + _unboundNames + {-# INLINE rule1576 #-} + rule1576 = \ ((_lefthandsideInumberOfPatterns) :: Int) -> + _lefthandsideInumberOfPatterns + {-# INLINE rule1577 #-} + rule1577 = \ ((_righthandsideIcollectScopeInfos) :: [(ScopeInfo, Entity)]) _scopeInfo -> + (_scopeInfo, Variable) : _righthandsideIcollectScopeInfos + {-# INLINE rule1578 #-} + rule1578 = \ ((_righthandsideIcollectInstances) :: [(Name, Instance)]) -> + _righthandsideIcollectInstances + {-# INLINE rule1579 #-} + rule1579 = \ ((_lefthandsideIself) :: LeftHandSide) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + FunctionBinding_FunctionBinding _rangeIself _lefthandsideIself _righthandsideIself + {-# INLINE rule1580 #-} + rule1580 = \ _self -> + _self + {-# INLINE rule1581 #-} + rule1581 = \ ((_righthandsideIcounter) :: Int) -> + _righthandsideIcounter + {-# INLINE rule1582 #-} + rule1582 = \ ((_righthandsideIkindErrors) :: [Error]) -> + _righthandsideIkindErrors + {-# INLINE rule1583 #-} + rule1583 = \ ((_righthandsideImiscerrors) :: [Error]) -> + _righthandsideImiscerrors + {-# INLINE rule1584 #-} + rule1584 = \ ((_lefthandsideIname) :: Name) -> + _lefthandsideIname + {-# INLINE rule1585 #-} + rule1585 = \ ((_righthandsideIwarnings) :: [Warning]) -> + _righthandsideIwarnings + {-# INLINE rule1586 #-} + rule1586 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1587 #-} + rule1587 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1588 #-} + rule1588 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1589 #-} + rule1589 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1590 #-} + rule1590 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1591 #-} + rule1591 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1592 #-} + rule1592 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1593 #-} + rule1593 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1594 #-} + rule1594 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1595 #-} + rule1595 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1596 #-} + rule1596 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1597 #-} + rule1597 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1598 #-} + rule1598 = \ ((_lefthandsideIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lefthandsideIcollectScopeInfos + {-# INLINE rule1599 #-} + rule1599 = \ ((_lefthandsideIcounter) :: Int) -> + _lefthandsideIcounter + {-# INLINE rule1600 #-} + rule1600 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1601 #-} + rule1601 = \ ((_lefthandsideImiscerrors) :: [Error]) -> + _lefthandsideImiscerrors + {-# INLINE rule1602 #-} + rule1602 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1603 #-} + rule1603 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1604 #-} + rule1604 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1605 #-} + rule1605 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1606 #-} + rule1606 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1607 #-} + rule1607 = \ ((_lefthandsideIwarnings) :: [Warning]) -> + _lefthandsideIwarnings + +-- FunctionBindings -------------------------------------------- +-- wrapper +data Inh_FunctionBindings = Inh_FunctionBindings { allTypeConstructors_Inh_FunctionBindings :: (Names), allValueConstructors_Inh_FunctionBindings :: (Names), classEnvironment_Inh_FunctionBindings :: (ClassEnvironment), collectScopeInfos_Inh_FunctionBindings :: ([(ScopeInfo, Entity)]), counter_Inh_FunctionBindings :: (Int), kindErrors_Inh_FunctionBindings :: ([Error]), miscerrors_Inh_FunctionBindings :: ([Error]), namesInScope_Inh_FunctionBindings :: (Names), options_Inh_FunctionBindings :: ([Option]), orderedTypeSynonyms_Inh_FunctionBindings :: (OrderedTypeSynonyms), typeConstructors_Inh_FunctionBindings :: (M.Map Name Int), valueConstructors_Inh_FunctionBindings :: (M.Map Name TpScheme), warnings_Inh_FunctionBindings :: ([Warning]) } +data Syn_FunctionBindings = Syn_FunctionBindings { arities_Syn_FunctionBindings :: ( [Int] ), collectInstances_Syn_FunctionBindings :: ([(Name, Instance)]), collectScopeInfos_Syn_FunctionBindings :: ([(ScopeInfo, Entity)]), counter_Syn_FunctionBindings :: (Int), kindErrors_Syn_FunctionBindings :: ([Error]), miscerrors_Syn_FunctionBindings :: ([Error]), name_Syn_FunctionBindings :: (Name), self_Syn_FunctionBindings :: (FunctionBindings), unboundNames_Syn_FunctionBindings :: (Names), warnings_Syn_FunctionBindings :: ([Warning]) } +{-# INLINABLE wrap_FunctionBindings #-} +wrap_FunctionBindings :: T_FunctionBindings -> Inh_FunctionBindings -> (Syn_FunctionBindings ) +wrap_FunctionBindings (T_FunctionBindings act) (Inh_FunctionBindings _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBindings_vIn58 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_FunctionBindings_vOut58 _lhsOarities _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOname _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_FunctionBindings_s59 sem arg) + return (Syn_FunctionBindings _lhsOarities _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOname _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_FunctionBindings #-} +sem_FunctionBindings :: FunctionBindings -> T_FunctionBindings +sem_FunctionBindings list = Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list) + +-- semantic domain +newtype T_FunctionBindings = T_FunctionBindings { + attach_T_FunctionBindings :: Identity (T_FunctionBindings_s59 ) + } +newtype T_FunctionBindings_s59 = C_FunctionBindings_s59 { + inv_FunctionBindings_s59 :: (T_FunctionBindings_v58 ) + } +data T_FunctionBindings_s60 = C_FunctionBindings_s60 +type T_FunctionBindings_v58 = (T_FunctionBindings_vIn58 ) -> (T_FunctionBindings_vOut58 ) +data T_FunctionBindings_vIn58 = T_FunctionBindings_vIn58 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_FunctionBindings_vOut58 = T_FunctionBindings_vOut58 ( [Int] ) ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Name) (FunctionBindings) (Names) ([Warning]) +{-# NOINLINE sem_FunctionBindings_Cons #-} +sem_FunctionBindings_Cons :: T_FunctionBinding -> T_FunctionBindings -> T_FunctionBindings +sem_FunctionBindings_Cons arg_hd_ arg_tl_ = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _hdX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_hd_)) + _tlX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_tl_)) + (T_FunctionBinding_vOut55 _hdIarity _hdIcollectInstances _hdIcollectScopeInfos _hdIcounter _hdIkindErrors _hdImiscerrors _hdIname _hdIself _hdIunboundNames _hdIwarnings) = inv_FunctionBinding_s56 _hdX56 (T_FunctionBinding_vIn55 _hdOallTypeConstructors _hdOallValueConstructors _hdOclassEnvironment _hdOcollectScopeInfos _hdOcounter _hdOkindErrors _hdOmiscerrors _hdOnamesInScope _hdOoptions _hdOorderedTypeSynonyms _hdOtypeConstructors _hdOvalueConstructors _hdOwarnings) + (T_FunctionBindings_vOut58 _tlIarities _tlIcollectInstances _tlIcollectScopeInfos _tlIcounter _tlIkindErrors _tlImiscerrors _tlIname _tlIself _tlIunboundNames _tlIwarnings) = inv_FunctionBindings_s59 _tlX59 (T_FunctionBindings_vIn58 _tlOallTypeConstructors _tlOallValueConstructors _tlOclassEnvironment _tlOcollectScopeInfos _tlOcounter _tlOkindErrors _tlOmiscerrors _tlOnamesInScope _tlOoptions _tlOorderedTypeSynonyms _tlOtypeConstructors _tlOvalueConstructors _tlOwarnings) + _lhsOname :: Name + _lhsOname = rule1608 _hdIname + _lhsOarities :: [Int] + _lhsOarities = rule1609 _hdIarity _tlIarities + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1610 _hdIcollectInstances _tlIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1611 _hdIunboundNames _tlIunboundNames + _self = rule1612 _hdIself _tlIself + _lhsOself :: FunctionBindings + _lhsOself = rule1613 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1614 _tlIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1615 _tlIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1616 _tlIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1617 _tlImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1618 _tlIwarnings + _hdOallTypeConstructors = rule1619 _lhsIallTypeConstructors + _hdOallValueConstructors = rule1620 _lhsIallValueConstructors + _hdOclassEnvironment = rule1621 _lhsIclassEnvironment + _hdOcollectScopeInfos = rule1622 _lhsIcollectScopeInfos + _hdOcounter = rule1623 _lhsIcounter + _hdOkindErrors = rule1624 _lhsIkindErrors + _hdOmiscerrors = rule1625 _lhsImiscerrors + _hdOnamesInScope = rule1626 _lhsInamesInScope + _hdOoptions = rule1627 _lhsIoptions + _hdOorderedTypeSynonyms = rule1628 _lhsIorderedTypeSynonyms + _hdOtypeConstructors = rule1629 _lhsItypeConstructors + _hdOvalueConstructors = rule1630 _lhsIvalueConstructors + _hdOwarnings = rule1631 _lhsIwarnings + _tlOallTypeConstructors = rule1632 _lhsIallTypeConstructors + _tlOallValueConstructors = rule1633 _lhsIallValueConstructors + _tlOclassEnvironment = rule1634 _lhsIclassEnvironment + _tlOcollectScopeInfos = rule1635 _hdIcollectScopeInfos + _tlOcounter = rule1636 _hdIcounter + _tlOkindErrors = rule1637 _hdIkindErrors + _tlOmiscerrors = rule1638 _hdImiscerrors + _tlOnamesInScope = rule1639 _lhsInamesInScope + _tlOoptions = rule1640 _lhsIoptions + _tlOorderedTypeSynonyms = rule1641 _lhsIorderedTypeSynonyms + _tlOtypeConstructors = rule1642 _lhsItypeConstructors + _tlOvalueConstructors = rule1643 _lhsIvalueConstructors + _tlOwarnings = rule1644 _hdIwarnings + __result_ = T_FunctionBindings_vOut58 _lhsOarities _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOname _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule1608 #-} + rule1608 = \ ((_hdIname) :: Name) -> + _hdIname + {-# INLINE rule1609 #-} + rule1609 = \ ((_hdIarity) :: Int) ((_tlIarities) :: [Int] ) -> + _hdIarity : _tlIarities + {-# INLINE rule1610 #-} + rule1610 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule1611 #-} + rule1611 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule1612 #-} + rule1612 = \ ((_hdIself) :: FunctionBinding) ((_tlIself) :: FunctionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule1613 #-} + rule1613 = \ _self -> + _self + {-# INLINE rule1614 #-} + rule1614 = \ ((_tlIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _tlIcollectScopeInfos + {-# INLINE rule1615 #-} + rule1615 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule1616 #-} + rule1616 = \ ((_tlIkindErrors) :: [Error]) -> + _tlIkindErrors + {-# INLINE rule1617 #-} + rule1617 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule1618 #-} + rule1618 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule1619 #-} + rule1619 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1620 #-} + rule1620 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1621 #-} + rule1621 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1622 #-} + rule1622 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1623 #-} + rule1623 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1624 #-} + rule1624 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1625 #-} + rule1625 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1626 #-} + rule1626 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1627 #-} + rule1627 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1628 #-} + rule1628 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1629 #-} + rule1629 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1630 #-} + rule1630 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1631 #-} + rule1631 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1632 #-} + rule1632 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1633 #-} + rule1633 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1634 #-} + rule1634 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1635 #-} + rule1635 = \ ((_hdIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _hdIcollectScopeInfos + {-# INLINE rule1636 #-} + rule1636 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule1637 #-} + rule1637 = \ ((_hdIkindErrors) :: [Error]) -> + _hdIkindErrors + {-# INLINE rule1638 #-} + rule1638 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule1639 #-} + rule1639 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1640 #-} + rule1640 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1641 #-} + rule1641 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1642 #-} + rule1642 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1643 #-} + rule1643 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1644 #-} + rule1644 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_FunctionBindings_Nil #-} +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOname :: Name + _lhsOname = rule1645 () + _lhsOarities :: [Int] + _lhsOarities = rule1646 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1647 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1648 () + _self = rule1649 () + _lhsOself :: FunctionBindings + _lhsOself = rule1650 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1651 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1652 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1653 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1654 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1655 _lhsIwarnings + __result_ = T_FunctionBindings_vOut58 _lhsOarities _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOname _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule1645 #-} + rule1645 = \ (_ :: ()) -> + internalError "StaticChecks.ag" "n/a" "empty FunctionBindings" + {-# INLINE rule1646 #-} + rule1646 = \ (_ :: ()) -> + [] + {-# INLINE rule1647 #-} + rule1647 = \ (_ :: ()) -> + [] + {-# INLINE rule1648 #-} + rule1648 = \ (_ :: ()) -> + [] + {-# INLINE rule1649 #-} + rule1649 = \ (_ :: ()) -> + [] + {-# INLINE rule1650 #-} + rule1650 = \ _self -> + _self + {-# INLINE rule1651 #-} + rule1651 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1652 #-} + rule1652 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1653 #-} + rule1653 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1654 #-} + rule1654 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1655 #-} + rule1655 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- GuardedExpression ------------------------------------------- +-- wrapper +data Inh_GuardedExpression = Inh_GuardedExpression { allTypeConstructors_Inh_GuardedExpression :: (Names), allValueConstructors_Inh_GuardedExpression :: (Names), classEnvironment_Inh_GuardedExpression :: (ClassEnvironment), collectScopeInfos_Inh_GuardedExpression :: ([(ScopeInfo, Entity)]), counter_Inh_GuardedExpression :: (Int), kindErrors_Inh_GuardedExpression :: ([Error]), miscerrors_Inh_GuardedExpression :: ([Error]), namesInScope_Inh_GuardedExpression :: (Names), options_Inh_GuardedExpression :: ([Option]), orderedTypeSynonyms_Inh_GuardedExpression :: (OrderedTypeSynonyms), typeConstructors_Inh_GuardedExpression :: (M.Map Name Int), valueConstructors_Inh_GuardedExpression :: (M.Map Name TpScheme), warnings_Inh_GuardedExpression :: ([Warning]) } +data Syn_GuardedExpression = Syn_GuardedExpression { collectInstances_Syn_GuardedExpression :: ([(Name, Instance)]), collectScopeInfos_Syn_GuardedExpression :: ([(ScopeInfo, Entity)]), counter_Syn_GuardedExpression :: (Int), kindErrors_Syn_GuardedExpression :: ([Error]), miscerrors_Syn_GuardedExpression :: ([Error]), self_Syn_GuardedExpression :: (GuardedExpression), unboundNames_Syn_GuardedExpression :: (Names), warnings_Syn_GuardedExpression :: ([Warning]) } +{-# INLINABLE wrap_GuardedExpression #-} +wrap_GuardedExpression :: T_GuardedExpression -> Inh_GuardedExpression -> (Syn_GuardedExpression ) +wrap_GuardedExpression (T_GuardedExpression act) (Inh_GuardedExpression _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpression_vIn61 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_GuardedExpression_vOut61 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_GuardedExpression_s62 sem arg) + return (Syn_GuardedExpression _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_GuardedExpression #-} +sem_GuardedExpression :: GuardedExpression -> T_GuardedExpression +sem_GuardedExpression ( GuardedExpression_GuardedExpression range_ guard_ expression_ ) = sem_GuardedExpression_GuardedExpression ( sem_Range range_ ) ( sem_Expression guard_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_GuardedExpression = T_GuardedExpression { + attach_T_GuardedExpression :: Identity (T_GuardedExpression_s62 ) + } +newtype T_GuardedExpression_s62 = C_GuardedExpression_s62 { + inv_GuardedExpression_s62 :: (T_GuardedExpression_v61 ) + } +data T_GuardedExpression_s63 = C_GuardedExpression_s63 +type T_GuardedExpression_v61 = (T_GuardedExpression_vIn61 ) -> (T_GuardedExpression_vOut61 ) +data T_GuardedExpression_vIn61 = T_GuardedExpression_vIn61 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_GuardedExpression_vOut61 = T_GuardedExpression_vOut61 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (GuardedExpression) (Names) ([Warning]) +{-# NOINLINE sem_GuardedExpression_GuardedExpression #-} +sem_GuardedExpression_GuardedExpression :: T_Range -> T_Expression -> T_Expression -> T_GuardedExpression +sem_GuardedExpression_GuardedExpression arg_range_ arg_guard_ arg_expression_ = T_GuardedExpression (return st62) where + {-# NOINLINE st62 #-} + st62 = let + v61 :: T_GuardedExpression_v61 + v61 = \ (T_GuardedExpression_vIn61 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIcollectInstances _guardIcollectScopeInfos _guardIcounter _guardIkindErrors _guardImiscerrors _guardIself _guardIunboundNames _guardIwarnings) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 _guardOallTypeConstructors _guardOallValueConstructors _guardOclassEnvironment _guardOcollectScopeInfos _guardOcounter _guardOkindErrors _guardOmiscerrors _guardOnamesInScope _guardOoptions _guardOorderedTypeSynonyms _guardOtypeConstructors _guardOvalueConstructors _guardOwarnings) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1656 _expressionIcollectInstances _guardIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1657 _expressionIunboundNames _guardIunboundNames + _self = rule1658 _expressionIself _guardIself _rangeIself + _lhsOself :: GuardedExpression + _lhsOself = rule1659 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1660 _expressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1661 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1662 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1663 _expressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1664 _expressionIwarnings + _guardOallTypeConstructors = rule1665 _lhsIallTypeConstructors + _guardOallValueConstructors = rule1666 _lhsIallValueConstructors + _guardOclassEnvironment = rule1667 _lhsIclassEnvironment + _guardOcollectScopeInfos = rule1668 _lhsIcollectScopeInfos + _guardOcounter = rule1669 _lhsIcounter + _guardOkindErrors = rule1670 _lhsIkindErrors + _guardOmiscerrors = rule1671 _lhsImiscerrors + _guardOnamesInScope = rule1672 _lhsInamesInScope + _guardOoptions = rule1673 _lhsIoptions + _guardOorderedTypeSynonyms = rule1674 _lhsIorderedTypeSynonyms + _guardOtypeConstructors = rule1675 _lhsItypeConstructors + _guardOvalueConstructors = rule1676 _lhsIvalueConstructors + _guardOwarnings = rule1677 _lhsIwarnings + _expressionOallTypeConstructors = rule1678 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule1679 _lhsIallValueConstructors + _expressionOclassEnvironment = rule1680 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule1681 _guardIcollectScopeInfos + _expressionOcounter = rule1682 _guardIcounter + _expressionOkindErrors = rule1683 _guardIkindErrors + _expressionOmiscerrors = rule1684 _guardImiscerrors + _expressionOnamesInScope = rule1685 _lhsInamesInScope + _expressionOoptions = rule1686 _lhsIoptions + _expressionOorderedTypeSynonyms = rule1687 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule1688 _lhsItypeConstructors + _expressionOvalueConstructors = rule1689 _lhsIvalueConstructors + _expressionOwarnings = rule1690 _guardIwarnings + __result_ = T_GuardedExpression_vOut61 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_GuardedExpression_s62 v61 + {-# INLINE rule1656 #-} + rule1656 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) ((_guardIcollectInstances) :: [(Name, Instance)]) -> + _guardIcollectInstances ++ _expressionIcollectInstances + {-# INLINE rule1657 #-} + rule1657 = \ ((_expressionIunboundNames) :: Names) ((_guardIunboundNames) :: Names) -> + _guardIunboundNames ++ _expressionIunboundNames + {-# INLINE rule1658 #-} + rule1658 = \ ((_expressionIself) :: Expression) ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + GuardedExpression_GuardedExpression _rangeIself _guardIself _expressionIself + {-# INLINE rule1659 #-} + rule1659 = \ _self -> + _self + {-# INLINE rule1660 #-} + rule1660 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule1661 #-} + rule1661 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1662 #-} + rule1662 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule1663 #-} + rule1663 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule1664 #-} + rule1664 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule1665 #-} + rule1665 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1666 #-} + rule1666 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1667 #-} + rule1667 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1668 #-} + rule1668 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1669 #-} + rule1669 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1670 #-} + rule1670 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1671 #-} + rule1671 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1672 #-} + rule1672 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1673 #-} + rule1673 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1674 #-} + rule1674 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1675 #-} + rule1675 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1676 #-} + rule1676 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1677 #-} + rule1677 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1678 #-} + rule1678 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1679 #-} + rule1679 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1680 #-} + rule1680 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1681 #-} + rule1681 = \ ((_guardIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _guardIcollectScopeInfos + {-# INLINE rule1682 #-} + rule1682 = \ ((_guardIcounter) :: Int) -> + _guardIcounter + {-# INLINE rule1683 #-} + rule1683 = \ ((_guardIkindErrors) :: [Error]) -> + _guardIkindErrors + {-# INLINE rule1684 #-} + rule1684 = \ ((_guardImiscerrors) :: [Error]) -> + _guardImiscerrors + {-# INLINE rule1685 #-} + rule1685 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1686 #-} + rule1686 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1687 #-} + rule1687 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1688 #-} + rule1688 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1689 #-} + rule1689 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1690 #-} + rule1690 = \ ((_guardIwarnings) :: [Warning]) -> + _guardIwarnings + +-- GuardedExpressions ------------------------------------------ +-- wrapper +data Inh_GuardedExpressions = Inh_GuardedExpressions { allTypeConstructors_Inh_GuardedExpressions :: (Names), allValueConstructors_Inh_GuardedExpressions :: (Names), classEnvironment_Inh_GuardedExpressions :: (ClassEnvironment), collectScopeInfos_Inh_GuardedExpressions :: ([(ScopeInfo, Entity)]), counter_Inh_GuardedExpressions :: (Int), kindErrors_Inh_GuardedExpressions :: ([Error]), miscerrors_Inh_GuardedExpressions :: ([Error]), namesInScope_Inh_GuardedExpressions :: (Names), options_Inh_GuardedExpressions :: ([Option]), orderedTypeSynonyms_Inh_GuardedExpressions :: (OrderedTypeSynonyms), typeConstructors_Inh_GuardedExpressions :: (M.Map Name Int), valueConstructors_Inh_GuardedExpressions :: (M.Map Name TpScheme), warnings_Inh_GuardedExpressions :: ([Warning]) } +data Syn_GuardedExpressions = Syn_GuardedExpressions { collectInstances_Syn_GuardedExpressions :: ([(Name, Instance)]), collectScopeInfos_Syn_GuardedExpressions :: ([(ScopeInfo, Entity)]), counter_Syn_GuardedExpressions :: (Int), kindErrors_Syn_GuardedExpressions :: ([Error]), miscerrors_Syn_GuardedExpressions :: ([Error]), self_Syn_GuardedExpressions :: (GuardedExpressions), unboundNames_Syn_GuardedExpressions :: (Names), warnings_Syn_GuardedExpressions :: ([Warning]) } +{-# INLINABLE wrap_GuardedExpressions #-} +wrap_GuardedExpressions :: T_GuardedExpressions -> Inh_GuardedExpressions -> (Syn_GuardedExpressions ) +wrap_GuardedExpressions (T_GuardedExpressions act) (Inh_GuardedExpressions _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpressions_vIn64 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_GuardedExpressions_vOut64 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_GuardedExpressions_s65 sem arg) + return (Syn_GuardedExpressions _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_GuardedExpressions #-} +sem_GuardedExpressions :: GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions list = Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list) + +-- semantic domain +newtype T_GuardedExpressions = T_GuardedExpressions { + attach_T_GuardedExpressions :: Identity (T_GuardedExpressions_s65 ) + } +newtype T_GuardedExpressions_s65 = C_GuardedExpressions_s65 { + inv_GuardedExpressions_s65 :: (T_GuardedExpressions_v64 ) + } +data T_GuardedExpressions_s66 = C_GuardedExpressions_s66 +type T_GuardedExpressions_v64 = (T_GuardedExpressions_vIn64 ) -> (T_GuardedExpressions_vOut64 ) +data T_GuardedExpressions_vIn64 = T_GuardedExpressions_vIn64 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_GuardedExpressions_vOut64 = T_GuardedExpressions_vOut64 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (GuardedExpressions) (Names) ([Warning]) +{-# NOINLINE sem_GuardedExpressions_Cons #-} +sem_GuardedExpressions_Cons :: T_GuardedExpression -> T_GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions_Cons arg_hd_ arg_tl_ = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _hdX62 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpression (arg_hd_)) + _tlX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_tl_)) + (T_GuardedExpression_vOut61 _hdIcollectInstances _hdIcollectScopeInfos _hdIcounter _hdIkindErrors _hdImiscerrors _hdIself _hdIunboundNames _hdIwarnings) = inv_GuardedExpression_s62 _hdX62 (T_GuardedExpression_vIn61 _hdOallTypeConstructors _hdOallValueConstructors _hdOclassEnvironment _hdOcollectScopeInfos _hdOcounter _hdOkindErrors _hdOmiscerrors _hdOnamesInScope _hdOoptions _hdOorderedTypeSynonyms _hdOtypeConstructors _hdOvalueConstructors _hdOwarnings) + (T_GuardedExpressions_vOut64 _tlIcollectInstances _tlIcollectScopeInfos _tlIcounter _tlIkindErrors _tlImiscerrors _tlIself _tlIunboundNames _tlIwarnings) = inv_GuardedExpressions_s65 _tlX65 (T_GuardedExpressions_vIn64 _tlOallTypeConstructors _tlOallValueConstructors _tlOclassEnvironment _tlOcollectScopeInfos _tlOcounter _tlOkindErrors _tlOmiscerrors _tlOnamesInScope _tlOoptions _tlOorderedTypeSynonyms _tlOtypeConstructors _tlOvalueConstructors _tlOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1691 _hdIcollectInstances _tlIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1692 _hdIunboundNames _tlIunboundNames + _self = rule1693 _hdIself _tlIself + _lhsOself :: GuardedExpressions + _lhsOself = rule1694 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1695 _tlIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1696 _tlIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1697 _tlIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1698 _tlImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1699 _tlIwarnings + _hdOallTypeConstructors = rule1700 _lhsIallTypeConstructors + _hdOallValueConstructors = rule1701 _lhsIallValueConstructors + _hdOclassEnvironment = rule1702 _lhsIclassEnvironment + _hdOcollectScopeInfos = rule1703 _lhsIcollectScopeInfos + _hdOcounter = rule1704 _lhsIcounter + _hdOkindErrors = rule1705 _lhsIkindErrors + _hdOmiscerrors = rule1706 _lhsImiscerrors + _hdOnamesInScope = rule1707 _lhsInamesInScope + _hdOoptions = rule1708 _lhsIoptions + _hdOorderedTypeSynonyms = rule1709 _lhsIorderedTypeSynonyms + _hdOtypeConstructors = rule1710 _lhsItypeConstructors + _hdOvalueConstructors = rule1711 _lhsIvalueConstructors + _hdOwarnings = rule1712 _lhsIwarnings + _tlOallTypeConstructors = rule1713 _lhsIallTypeConstructors + _tlOallValueConstructors = rule1714 _lhsIallValueConstructors + _tlOclassEnvironment = rule1715 _lhsIclassEnvironment + _tlOcollectScopeInfos = rule1716 _hdIcollectScopeInfos + _tlOcounter = rule1717 _hdIcounter + _tlOkindErrors = rule1718 _hdIkindErrors + _tlOmiscerrors = rule1719 _hdImiscerrors + _tlOnamesInScope = rule1720 _lhsInamesInScope + _tlOoptions = rule1721 _lhsIoptions + _tlOorderedTypeSynonyms = rule1722 _lhsIorderedTypeSynonyms + _tlOtypeConstructors = rule1723 _lhsItypeConstructors + _tlOvalueConstructors = rule1724 _lhsIvalueConstructors + _tlOwarnings = rule1725 _hdIwarnings + __result_ = T_GuardedExpressions_vOut64 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule1691 #-} + rule1691 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule1692 #-} + rule1692 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule1693 #-} + rule1693 = \ ((_hdIself) :: GuardedExpression) ((_tlIself) :: GuardedExpressions) -> + (:) _hdIself _tlIself + {-# INLINE rule1694 #-} + rule1694 = \ _self -> + _self + {-# INLINE rule1695 #-} + rule1695 = \ ((_tlIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _tlIcollectScopeInfos + {-# INLINE rule1696 #-} + rule1696 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule1697 #-} + rule1697 = \ ((_tlIkindErrors) :: [Error]) -> + _tlIkindErrors + {-# INLINE rule1698 #-} + rule1698 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule1699 #-} + rule1699 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule1700 #-} + rule1700 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1701 #-} + rule1701 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1702 #-} + rule1702 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1703 #-} + rule1703 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1704 #-} + rule1704 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1705 #-} + rule1705 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1706 #-} + rule1706 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1707 #-} + rule1707 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1708 #-} + rule1708 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1709 #-} + rule1709 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1710 #-} + rule1710 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1711 #-} + rule1711 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1712 #-} + rule1712 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1713 #-} + rule1713 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1714 #-} + rule1714 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1715 #-} + rule1715 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1716 #-} + rule1716 = \ ((_hdIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _hdIcollectScopeInfos + {-# INLINE rule1717 #-} + rule1717 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule1718 #-} + rule1718 = \ ((_hdIkindErrors) :: [Error]) -> + _hdIkindErrors + {-# INLINE rule1719 #-} + rule1719 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule1720 #-} + rule1720 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1721 #-} + rule1721 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1722 #-} + rule1722 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1723 #-} + rule1723 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1724 #-} + rule1724 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1725 #-} + rule1725 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_GuardedExpressions_Nil #-} +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1726 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1727 () + _self = rule1728 () + _lhsOself :: GuardedExpressions + _lhsOself = rule1729 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1730 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1731 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1732 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1733 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1734 _lhsIwarnings + __result_ = T_GuardedExpressions_vOut64 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule1726 #-} + rule1726 = \ (_ :: ()) -> + [] + {-# INLINE rule1727 #-} + rule1727 = \ (_ :: ()) -> + [] + {-# INLINE rule1728 #-} + rule1728 = \ (_ :: ()) -> + [] + {-# INLINE rule1729 #-} + rule1729 = \ _self -> + _self + {-# INLINE rule1730 #-} + rule1730 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1731 #-} + rule1731 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1732 #-} + rule1732 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1733 #-} + rule1733 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1734 #-} + rule1734 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Import ------------------------------------------------------ +-- wrapper +data Inh_Import = Inh_Import { } +data Syn_Import = Syn_Import { self_Syn_Import :: (Import) } +{-# INLINABLE wrap_Import #-} +wrap_Import :: T_Import -> Inh_Import -> (Syn_Import ) +wrap_Import (T_Import act) (Inh_Import ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Import_vIn67 + (T_Import_vOut67 _lhsOself) <- return (inv_Import_s68 sem arg) + return (Syn_Import _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Import #-} +sem_Import :: Import -> T_Import +sem_Import ( Import_Variable range_ name_ ) = sem_Import_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Import ( Import_TypeOrClass range_ name_ names_ ) = sem_Import_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Import ( Import_TypeOrClassComplete range_ name_ ) = sem_Import_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Import = T_Import { + attach_T_Import :: Identity (T_Import_s68 ) + } +newtype T_Import_s68 = C_Import_s68 { + inv_Import_s68 :: (T_Import_v67 ) + } +data T_Import_s69 = C_Import_s69 +type T_Import_v67 = (T_Import_vIn67 ) -> (T_Import_vOut67 ) +data T_Import_vIn67 = T_Import_vIn67 +data T_Import_vOut67 = T_Import_vOut67 (Import) +{-# NOINLINE sem_Import_Variable #-} +sem_Import_Variable :: T_Range -> T_Name -> T_Import +sem_Import_Variable arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule1735 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule1736 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule1735 #-} + rule1735 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_Variable _rangeIself _nameIself + {-# INLINE rule1736 #-} + rule1736 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClass #-} +sem_Import_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Import +sem_Import_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _self = rule1737 _nameIself _namesIself _rangeIself + _lhsOself :: Import + _lhsOself = rule1738 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule1737 #-} + rule1737 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Import_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule1738 #-} + rule1738 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClassComplete #-} +sem_Import_TypeOrClassComplete :: T_Range -> T_Name -> T_Import +sem_Import_TypeOrClassComplete arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule1739 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule1740 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule1739 #-} + rule1739 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule1740 #-} + rule1740 = \ _self -> + _self + +-- ImportDeclaration ------------------------------------------- +-- wrapper +data Inh_ImportDeclaration = Inh_ImportDeclaration { importedModules_Inh_ImportDeclaration :: (Names) } +data Syn_ImportDeclaration = Syn_ImportDeclaration { importedModules_Syn_ImportDeclaration :: (Names), self_Syn_ImportDeclaration :: (ImportDeclaration) } +{-# INLINABLE wrap_ImportDeclaration #-} +wrap_ImportDeclaration :: T_ImportDeclaration -> Inh_ImportDeclaration -> (Syn_ImportDeclaration ) +wrap_ImportDeclaration (T_ImportDeclaration act) (Inh_ImportDeclaration _lhsIimportedModules) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclaration_vIn70 _lhsIimportedModules + (T_ImportDeclaration_vOut70 _lhsOimportedModules _lhsOself) <- return (inv_ImportDeclaration_s71 sem arg) + return (Syn_ImportDeclaration _lhsOimportedModules _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclaration #-} +sem_ImportDeclaration :: ImportDeclaration -> T_ImportDeclaration +sem_ImportDeclaration ( ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ ) = sem_ImportDeclaration_Import ( sem_Range range_ ) qualified_ ( sem_Name name_ ) ( sem_MaybeName asname_ ) ( sem_MaybeImportSpecification importspecification_ ) +sem_ImportDeclaration ( ImportDeclaration_Empty range_ ) = sem_ImportDeclaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_ImportDeclaration = T_ImportDeclaration { + attach_T_ImportDeclaration :: Identity (T_ImportDeclaration_s71 ) + } +newtype T_ImportDeclaration_s71 = C_ImportDeclaration_s71 { + inv_ImportDeclaration_s71 :: (T_ImportDeclaration_v70 ) + } +data T_ImportDeclaration_s72 = C_ImportDeclaration_s72 +type T_ImportDeclaration_v70 = (T_ImportDeclaration_vIn70 ) -> (T_ImportDeclaration_vOut70 ) +data T_ImportDeclaration_vIn70 = T_ImportDeclaration_vIn70 (Names) +data T_ImportDeclaration_vOut70 = T_ImportDeclaration_vOut70 (Names) (ImportDeclaration) +{-# NOINLINE sem_ImportDeclaration_Import #-} +sem_ImportDeclaration_Import :: T_Range -> (Bool) -> T_Name -> T_MaybeName -> T_MaybeImportSpecification -> T_ImportDeclaration +sem_ImportDeclaration_Import arg_range_ arg_qualified_ arg_name_ arg_asname_ arg_importspecification_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 _lhsIimportedModules) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _asnameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_asname_)) + _importspecificationX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeImportSpecification (arg_importspecification_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeName_vOut103 _asnameIself) = inv_MaybeName_s104 _asnameX104 (T_MaybeName_vIn103 ) + (T_MaybeImportSpecification_vOut97 _importspecificationIself) = inv_MaybeImportSpecification_s98 _importspecificationX98 (T_MaybeImportSpecification_vIn97 ) + _lhsOimportedModules :: Names + _lhsOimportedModules = rule1741 _lhsIimportedModules _nameIself + _self = rule1742 _asnameIself _importspecificationIself _nameIself _rangeIself arg_qualified_ + _lhsOself :: ImportDeclaration + _lhsOself = rule1743 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOimportedModules _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule1741 #-} + rule1741 = \ ((_lhsIimportedModules) :: Names) ((_nameIself) :: Name) -> + _nameIself : _lhsIimportedModules + {-# INLINE rule1742 #-} + rule1742 = \ ((_asnameIself) :: MaybeName) ((_importspecificationIself) :: MaybeImportSpecification) ((_nameIself) :: Name) ((_rangeIself) :: Range) qualified_ -> + ImportDeclaration_Import _rangeIself qualified_ _nameIself _asnameIself _importspecificationIself + {-# INLINE rule1743 #-} + rule1743 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclaration_Empty #-} +sem_ImportDeclaration_Empty :: T_Range -> T_ImportDeclaration +sem_ImportDeclaration_Empty arg_range_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 _lhsIimportedModules) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule1744 _rangeIself + _lhsOself :: ImportDeclaration + _lhsOself = rule1745 _self + _lhsOimportedModules :: Names + _lhsOimportedModules = rule1746 _lhsIimportedModules + __result_ = T_ImportDeclaration_vOut70 _lhsOimportedModules _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule1744 #-} + rule1744 = \ ((_rangeIself) :: Range) -> + ImportDeclaration_Empty _rangeIself + {-# INLINE rule1745 #-} + rule1745 = \ _self -> + _self + {-# INLINE rule1746 #-} + rule1746 = \ ((_lhsIimportedModules) :: Names) -> + _lhsIimportedModules + +-- ImportDeclarations ------------------------------------------ +-- wrapper +data Inh_ImportDeclarations = Inh_ImportDeclarations { importedModules_Inh_ImportDeclarations :: (Names) } +data Syn_ImportDeclarations = Syn_ImportDeclarations { importedModules_Syn_ImportDeclarations :: (Names), self_Syn_ImportDeclarations :: (ImportDeclarations) } +{-# INLINABLE wrap_ImportDeclarations #-} +wrap_ImportDeclarations :: T_ImportDeclarations -> Inh_ImportDeclarations -> (Syn_ImportDeclarations ) +wrap_ImportDeclarations (T_ImportDeclarations act) (Inh_ImportDeclarations _lhsIimportedModules) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclarations_vIn73 _lhsIimportedModules + (T_ImportDeclarations_vOut73 _lhsOimportedModules _lhsOself) <- return (inv_ImportDeclarations_s74 sem arg) + return (Syn_ImportDeclarations _lhsOimportedModules _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclarations #-} +sem_ImportDeclarations :: ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations list = Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list) + +-- semantic domain +newtype T_ImportDeclarations = T_ImportDeclarations { + attach_T_ImportDeclarations :: Identity (T_ImportDeclarations_s74 ) + } +newtype T_ImportDeclarations_s74 = C_ImportDeclarations_s74 { + inv_ImportDeclarations_s74 :: (T_ImportDeclarations_v73 ) + } +data T_ImportDeclarations_s75 = C_ImportDeclarations_s75 +type T_ImportDeclarations_v73 = (T_ImportDeclarations_vIn73 ) -> (T_ImportDeclarations_vOut73 ) +data T_ImportDeclarations_vIn73 = T_ImportDeclarations_vIn73 (Names) +data T_ImportDeclarations_vOut73 = T_ImportDeclarations_vOut73 (Names) (ImportDeclarations) +{-# NOINLINE sem_ImportDeclarations_Cons #-} +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> T_ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations_Cons arg_hd_ arg_tl_ = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 _lhsIimportedModules) -> ( let + _hdX71 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclaration (arg_hd_)) + _tlX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_tl_)) + (T_ImportDeclaration_vOut70 _hdIimportedModules _hdIself) = inv_ImportDeclaration_s71 _hdX71 (T_ImportDeclaration_vIn70 _hdOimportedModules) + (T_ImportDeclarations_vOut73 _tlIimportedModules _tlIself) = inv_ImportDeclarations_s74 _tlX74 (T_ImportDeclarations_vIn73 _tlOimportedModules) + _self = rule1747 _hdIself _tlIself + _lhsOself :: ImportDeclarations + _lhsOself = rule1748 _self + _lhsOimportedModules :: Names + _lhsOimportedModules = rule1749 _tlIimportedModules + _hdOimportedModules = rule1750 _lhsIimportedModules + _tlOimportedModules = rule1751 _hdIimportedModules + __result_ = T_ImportDeclarations_vOut73 _lhsOimportedModules _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule1747 #-} + rule1747 = \ ((_hdIself) :: ImportDeclaration) ((_tlIself) :: ImportDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule1748 #-} + rule1748 = \ _self -> + _self + {-# INLINE rule1749 #-} + rule1749 = \ ((_tlIimportedModules) :: Names) -> + _tlIimportedModules + {-# INLINE rule1750 #-} + rule1750 = \ ((_lhsIimportedModules) :: Names) -> + _lhsIimportedModules + {-# INLINE rule1751 #-} + rule1751 = \ ((_hdIimportedModules) :: Names) -> + _hdIimportedModules +{-# NOINLINE sem_ImportDeclarations_Nil #-} +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 _lhsIimportedModules) -> ( let + _self = rule1752 () + _lhsOself :: ImportDeclarations + _lhsOself = rule1753 _self + _lhsOimportedModules :: Names + _lhsOimportedModules = rule1754 _lhsIimportedModules + __result_ = T_ImportDeclarations_vOut73 _lhsOimportedModules _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule1752 #-} + rule1752 = \ (_ :: ()) -> + [] + {-# INLINE rule1753 #-} + rule1753 = \ _self -> + _self + {-# INLINE rule1754 #-} + rule1754 = \ ((_lhsIimportedModules) :: Names) -> + _lhsIimportedModules + +-- ImportSpecification ----------------------------------------- +-- wrapper +data Inh_ImportSpecification = Inh_ImportSpecification { } +data Syn_ImportSpecification = Syn_ImportSpecification { self_Syn_ImportSpecification :: (ImportSpecification) } +{-# INLINABLE wrap_ImportSpecification #-} +wrap_ImportSpecification :: T_ImportSpecification -> Inh_ImportSpecification -> (Syn_ImportSpecification ) +wrap_ImportSpecification (T_ImportSpecification act) (Inh_ImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportSpecification_vIn76 + (T_ImportSpecification_vOut76 _lhsOself) <- return (inv_ImportSpecification_s77 sem arg) + return (Syn_ImportSpecification _lhsOself) + ) + +-- cata +{-# INLINE sem_ImportSpecification #-} +sem_ImportSpecification :: ImportSpecification -> T_ImportSpecification +sem_ImportSpecification ( ImportSpecification_Import range_ hiding_ imports_ ) = sem_ImportSpecification_Import ( sem_Range range_ ) hiding_ ( sem_Imports imports_ ) + +-- semantic domain +newtype T_ImportSpecification = T_ImportSpecification { + attach_T_ImportSpecification :: Identity (T_ImportSpecification_s77 ) + } +newtype T_ImportSpecification_s77 = C_ImportSpecification_s77 { + inv_ImportSpecification_s77 :: (T_ImportSpecification_v76 ) + } +data T_ImportSpecification_s78 = C_ImportSpecification_s78 +type T_ImportSpecification_v76 = (T_ImportSpecification_vIn76 ) -> (T_ImportSpecification_vOut76 ) +data T_ImportSpecification_vIn76 = T_ImportSpecification_vIn76 +data T_ImportSpecification_vOut76 = T_ImportSpecification_vOut76 (ImportSpecification) +{-# NOINLINE sem_ImportSpecification_Import #-} +sem_ImportSpecification_Import :: T_Range -> (Bool) -> T_Imports -> T_ImportSpecification +sem_ImportSpecification_Import arg_range_ arg_hiding_ arg_imports_ = T_ImportSpecification (return st77) where + {-# NOINLINE st77 #-} + st77 = let + v76 :: T_ImportSpecification_v76 + v76 = \ (T_ImportSpecification_vIn76 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importsX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_imports_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Imports_vOut79 _importsIself) = inv_Imports_s80 _importsX80 (T_Imports_vIn79 ) + _self = rule1755 _importsIself _rangeIself arg_hiding_ + _lhsOself :: ImportSpecification + _lhsOself = rule1756 _self + __result_ = T_ImportSpecification_vOut76 _lhsOself + in __result_ ) + in C_ImportSpecification_s77 v76 + {-# INLINE rule1755 #-} + rule1755 = \ ((_importsIself) :: Imports) ((_rangeIself) :: Range) hiding_ -> + ImportSpecification_Import _rangeIself hiding_ _importsIself + {-# INLINE rule1756 #-} + rule1756 = \ _self -> + _self + +-- Imports ----------------------------------------------------- +-- wrapper +data Inh_Imports = Inh_Imports { } +data Syn_Imports = Syn_Imports { self_Syn_Imports :: (Imports) } +{-# INLINABLE wrap_Imports #-} +wrap_Imports :: T_Imports -> Inh_Imports -> (Syn_Imports ) +wrap_Imports (T_Imports act) (Inh_Imports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Imports_vIn79 + (T_Imports_vOut79 _lhsOself) <- return (inv_Imports_s80 sem arg) + return (Syn_Imports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Imports #-} +sem_Imports :: Imports -> T_Imports +sem_Imports list = Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list) + +-- semantic domain +newtype T_Imports = T_Imports { + attach_T_Imports :: Identity (T_Imports_s80 ) + } +newtype T_Imports_s80 = C_Imports_s80 { + inv_Imports_s80 :: (T_Imports_v79 ) + } +data T_Imports_s81 = C_Imports_s81 +type T_Imports_v79 = (T_Imports_vIn79 ) -> (T_Imports_vOut79 ) +data T_Imports_vIn79 = T_Imports_vIn79 +data T_Imports_vOut79 = T_Imports_vOut79 (Imports) +{-# NOINLINE sem_Imports_Cons #-} +sem_Imports_Cons :: T_Import -> T_Imports -> T_Imports +sem_Imports_Cons arg_hd_ arg_tl_ = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _hdX68 = Control.Monad.Identity.runIdentity (attach_T_Import (arg_hd_)) + _tlX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_tl_)) + (T_Import_vOut67 _hdIself) = inv_Import_s68 _hdX68 (T_Import_vIn67 ) + (T_Imports_vOut79 _tlIself) = inv_Imports_s80 _tlX80 (T_Imports_vIn79 ) + _self = rule1757 _hdIself _tlIself + _lhsOself :: Imports + _lhsOself = rule1758 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule1757 #-} + rule1757 = \ ((_hdIself) :: Import) ((_tlIself) :: Imports) -> + (:) _hdIself _tlIself + {-# INLINE rule1758 #-} + rule1758 = \ _self -> + _self +{-# NOINLINE sem_Imports_Nil #-} +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _self = rule1759 () + _lhsOself :: Imports + _lhsOself = rule1760 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule1759 #-} + rule1759 = \ (_ :: ()) -> + [] + {-# INLINE rule1760 #-} + rule1760 = \ _self -> + _self + +-- LeftHandSide ------------------------------------------------ +-- wrapper +data Inh_LeftHandSide = Inh_LeftHandSide { allTypeConstructors_Inh_LeftHandSide :: (Names), allValueConstructors_Inh_LeftHandSide :: (Names), collectScopeInfos_Inh_LeftHandSide :: ([(ScopeInfo, Entity)]), counter_Inh_LeftHandSide :: (Int), miscerrors_Inh_LeftHandSide :: ([Error]), namesInScope_Inh_LeftHandSide :: (Names), typeConstructors_Inh_LeftHandSide :: (M.Map Name Int), valueConstructors_Inh_LeftHandSide :: (M.Map Name TpScheme), warnings_Inh_LeftHandSide :: ([Warning]) } +data Syn_LeftHandSide = Syn_LeftHandSide { collectScopeInfos_Syn_LeftHandSide :: ([(ScopeInfo, Entity)]), counter_Syn_LeftHandSide :: (Int), miscerrors_Syn_LeftHandSide :: ([Error]), name_Syn_LeftHandSide :: (Name), numberOfPatterns_Syn_LeftHandSide :: (Int), patVarNames_Syn_LeftHandSide :: (Names), self_Syn_LeftHandSide :: (LeftHandSide), unboundNames_Syn_LeftHandSide :: (Names), warnings_Syn_LeftHandSide :: ([Warning]) } +{-# INLINABLE wrap_LeftHandSide #-} +wrap_LeftHandSide :: T_LeftHandSide -> Inh_LeftHandSide -> (Syn_LeftHandSide ) +wrap_LeftHandSide (T_LeftHandSide act) (Inh_LeftHandSide _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_LeftHandSide_vIn82 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_LeftHandSide_vOut82 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOname _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_LeftHandSide_s83 sem arg) + return (Syn_LeftHandSide _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOname _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_LeftHandSide #-} +sem_LeftHandSide :: LeftHandSide -> T_LeftHandSide +sem_LeftHandSide ( LeftHandSide_Function range_ name_ patterns_ ) = sem_LeftHandSide_Function ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_LeftHandSide ( LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ ) = sem_LeftHandSide_Infix ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name operator_ ) ( sem_Pattern rightPattern_ ) +sem_LeftHandSide ( LeftHandSide_Parenthesized range_ lefthandside_ patterns_ ) = sem_LeftHandSide_Parenthesized ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_Patterns patterns_ ) + +-- semantic domain +newtype T_LeftHandSide = T_LeftHandSide { + attach_T_LeftHandSide :: Identity (T_LeftHandSide_s83 ) + } +newtype T_LeftHandSide_s83 = C_LeftHandSide_s83 { + inv_LeftHandSide_s83 :: (T_LeftHandSide_v82 ) + } +data T_LeftHandSide_s84 = C_LeftHandSide_s84 +type T_LeftHandSide_v82 = (T_LeftHandSide_vIn82 ) -> (T_LeftHandSide_vOut82 ) +data T_LeftHandSide_vIn82 = T_LeftHandSide_vIn82 (Names) (Names) ([(ScopeInfo, Entity)]) (Int) ([Error]) (Names) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_LeftHandSide_vOut82 = T_LeftHandSide_vOut82 ([(ScopeInfo, Entity)]) (Int) ([Error]) (Name) (Int) (Names) (LeftHandSide) (Names) ([Warning]) +{-# NOINLINE sem_LeftHandSide_Function #-} +sem_LeftHandSide_Function :: T_Range -> T_Name -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Function arg_range_ arg_name_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIcollectScopeInfos _patternsIcounter _patternsImiscerrors _patternsInumberOfPatterns _patternsIpatVarNames _patternsIself _patternsIunboundNames _patternsIwarnings) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOallTypeConstructors _patternsOallValueConstructors _patternsOcollectScopeInfos _patternsOcounter _patternsOlhsPattern _patternsOmiscerrors _patternsOnamesInScope _patternsOtypeConstructors _patternsOvalueConstructors _patternsOwarnings) + _lhsOname :: Name + _lhsOname = rule1761 _nameIself + _patternsOlhsPattern = rule1762 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule1763 _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1764 _patternsIunboundNames + _self = rule1765 _nameIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule1766 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1767 _patternsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1768 _patternsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1769 _patternsImiscerrors + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule1770 _patternsInumberOfPatterns + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1771 _patternsIwarnings + _patternsOallTypeConstructors = rule1772 _lhsIallTypeConstructors + _patternsOallValueConstructors = rule1773 _lhsIallValueConstructors + _patternsOcollectScopeInfos = rule1774 _lhsIcollectScopeInfos + _patternsOcounter = rule1775 _lhsIcounter + _patternsOmiscerrors = rule1776 _lhsImiscerrors + _patternsOnamesInScope = rule1777 _lhsInamesInScope + _patternsOtypeConstructors = rule1778 _lhsItypeConstructors + _patternsOvalueConstructors = rule1779 _lhsIvalueConstructors + _patternsOwarnings = rule1780 _lhsIwarnings + __result_ = T_LeftHandSide_vOut82 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOname _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule1761 #-} + rule1761 = \ ((_nameIself) :: Name) -> + _nameIself + {-# INLINE rule1762 #-} + rule1762 = \ (_ :: ()) -> + False + {-# INLINE rule1763 #-} + rule1763 = \ ((_patternsIpatVarNames) :: Names) -> + _patternsIpatVarNames + {-# INLINE rule1764 #-} + rule1764 = \ ((_patternsIunboundNames) :: Names) -> + _patternsIunboundNames + {-# INLINE rule1765 #-} + rule1765 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Function _rangeIself _nameIself _patternsIself + {-# INLINE rule1766 #-} + rule1766 = \ _self -> + _self + {-# INLINE rule1767 #-} + rule1767 = \ ((_patternsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternsIcollectScopeInfos + {-# INLINE rule1768 #-} + rule1768 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule1769 #-} + rule1769 = \ ((_patternsImiscerrors) :: [Error]) -> + _patternsImiscerrors + {-# INLINE rule1770 #-} + rule1770 = \ ((_patternsInumberOfPatterns) :: Int) -> + _patternsInumberOfPatterns + {-# INLINE rule1771 #-} + rule1771 = \ ((_patternsIwarnings) :: [Warning]) -> + _patternsIwarnings + {-# INLINE rule1772 #-} + rule1772 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1773 #-} + rule1773 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1774 #-} + rule1774 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1775 #-} + rule1775 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1776 #-} + rule1776 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1777 #-} + rule1777 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1778 #-} + rule1778 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1779 #-} + rule1779 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1780 #-} + rule1780 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_LeftHandSide_Infix #-} +sem_LeftHandSide_Infix :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_LeftHandSide +sem_LeftHandSide_Infix arg_range_ arg_leftPattern_ arg_operator_ arg_rightPattern_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _operatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_operator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIcollectScopeInfos _leftPatternIcounter _leftPatternImiscerrors _leftPatternIpatVarNames _leftPatternIself _leftPatternIunboundNames _leftPatternIwarnings) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 _leftPatternOallTypeConstructors _leftPatternOallValueConstructors _leftPatternOcollectScopeInfos _leftPatternOcounter _leftPatternOlhsPattern _leftPatternOmiscerrors _leftPatternOnamesInScope _leftPatternOtypeConstructors _leftPatternOvalueConstructors _leftPatternOwarnings) + (T_Name_vOut112 _operatorIself) = inv_Name_s113 _operatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIcollectScopeInfos _rightPatternIcounter _rightPatternImiscerrors _rightPatternIpatVarNames _rightPatternIself _rightPatternIunboundNames _rightPatternIwarnings) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 _rightPatternOallTypeConstructors _rightPatternOallValueConstructors _rightPatternOcollectScopeInfos _rightPatternOcounter _rightPatternOlhsPattern _rightPatternOmiscerrors _rightPatternOnamesInScope _rightPatternOtypeConstructors _rightPatternOvalueConstructors _rightPatternOwarnings) + _lhsOname :: Name + _lhsOname = rule1781 _operatorIself + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule1782 () + _leftPatternOlhsPattern = rule1783 () + _rightPatternOlhsPattern = rule1784 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule1785 _leftPatternIpatVarNames _rightPatternIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1786 _leftPatternIunboundNames _rightPatternIunboundNames + _self = rule1787 _leftPatternIself _operatorIself _rangeIself _rightPatternIself + _lhsOself :: LeftHandSide + _lhsOself = rule1788 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1789 _rightPatternIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1790 _rightPatternIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1791 _rightPatternImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1792 _rightPatternIwarnings + _leftPatternOallTypeConstructors = rule1793 _lhsIallTypeConstructors + _leftPatternOallValueConstructors = rule1794 _lhsIallValueConstructors + _leftPatternOcollectScopeInfos = rule1795 _lhsIcollectScopeInfos + _leftPatternOcounter = rule1796 _lhsIcounter + _leftPatternOmiscerrors = rule1797 _lhsImiscerrors + _leftPatternOnamesInScope = rule1798 _lhsInamesInScope + _leftPatternOtypeConstructors = rule1799 _lhsItypeConstructors + _leftPatternOvalueConstructors = rule1800 _lhsIvalueConstructors + _leftPatternOwarnings = rule1801 _lhsIwarnings + _rightPatternOallTypeConstructors = rule1802 _lhsIallTypeConstructors + _rightPatternOallValueConstructors = rule1803 _lhsIallValueConstructors + _rightPatternOcollectScopeInfos = rule1804 _leftPatternIcollectScopeInfos + _rightPatternOcounter = rule1805 _leftPatternIcounter + _rightPatternOmiscerrors = rule1806 _leftPatternImiscerrors + _rightPatternOnamesInScope = rule1807 _lhsInamesInScope + _rightPatternOtypeConstructors = rule1808 _lhsItypeConstructors + _rightPatternOvalueConstructors = rule1809 _lhsIvalueConstructors + _rightPatternOwarnings = rule1810 _leftPatternIwarnings + __result_ = T_LeftHandSide_vOut82 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOname _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule1781 #-} + rule1781 = \ ((_operatorIself) :: Name) -> + _operatorIself + {-# INLINE rule1782 #-} + rule1782 = \ (_ :: ()) -> + 2 + {-# INLINE rule1783 #-} + rule1783 = \ (_ :: ()) -> + False + {-# INLINE rule1784 #-} + rule1784 = \ (_ :: ()) -> + False + {-# INLINE rule1785 #-} + rule1785 = \ ((_leftPatternIpatVarNames) :: Names) ((_rightPatternIpatVarNames) :: Names) -> + _leftPatternIpatVarNames ++ _rightPatternIpatVarNames + {-# INLINE rule1786 #-} + rule1786 = \ ((_leftPatternIunboundNames) :: Names) ((_rightPatternIunboundNames) :: Names) -> + _leftPatternIunboundNames ++ _rightPatternIunboundNames + {-# INLINE rule1787 #-} + rule1787 = \ ((_leftPatternIself) :: Pattern) ((_operatorIself) :: Name) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + LeftHandSide_Infix _rangeIself _leftPatternIself _operatorIself _rightPatternIself + {-# INLINE rule1788 #-} + rule1788 = \ _self -> + _self + {-# INLINE rule1789 #-} + rule1789 = \ ((_rightPatternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _rightPatternIcollectScopeInfos + {-# INLINE rule1790 #-} + rule1790 = \ ((_rightPatternIcounter) :: Int) -> + _rightPatternIcounter + {-# INLINE rule1791 #-} + rule1791 = \ ((_rightPatternImiscerrors) :: [Error]) -> + _rightPatternImiscerrors + {-# INLINE rule1792 #-} + rule1792 = \ ((_rightPatternIwarnings) :: [Warning]) -> + _rightPatternIwarnings + {-# INLINE rule1793 #-} + rule1793 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1794 #-} + rule1794 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1795 #-} + rule1795 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1796 #-} + rule1796 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1797 #-} + rule1797 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1798 #-} + rule1798 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1799 #-} + rule1799 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1800 #-} + rule1800 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1801 #-} + rule1801 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1802 #-} + rule1802 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1803 #-} + rule1803 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1804 #-} + rule1804 = \ ((_leftPatternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _leftPatternIcollectScopeInfos + {-# INLINE rule1805 #-} + rule1805 = \ ((_leftPatternIcounter) :: Int) -> + _leftPatternIcounter + {-# INLINE rule1806 #-} + rule1806 = \ ((_leftPatternImiscerrors) :: [Error]) -> + _leftPatternImiscerrors + {-# INLINE rule1807 #-} + rule1807 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1808 #-} + rule1808 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1809 #-} + rule1809 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1810 #-} + rule1810 = \ ((_leftPatternIwarnings) :: [Warning]) -> + _leftPatternIwarnings +{-# NOINLINE sem_LeftHandSide_Parenthesized #-} +sem_LeftHandSide_Parenthesized :: T_Range -> T_LeftHandSide -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Parenthesized arg_range_ arg_lefthandside_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIcollectScopeInfos _lefthandsideIcounter _lefthandsideImiscerrors _lefthandsideIname _lefthandsideInumberOfPatterns _lefthandsideIpatVarNames _lefthandsideIself _lefthandsideIunboundNames _lefthandsideIwarnings) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 _lefthandsideOallTypeConstructors _lefthandsideOallValueConstructors _lefthandsideOcollectScopeInfos _lefthandsideOcounter _lefthandsideOmiscerrors _lefthandsideOnamesInScope _lefthandsideOtypeConstructors _lefthandsideOvalueConstructors _lefthandsideOwarnings) + (T_Patterns_vOut121 _patternsIcollectScopeInfos _patternsIcounter _patternsImiscerrors _patternsInumberOfPatterns _patternsIpatVarNames _patternsIself _patternsIunboundNames _patternsIwarnings) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOallTypeConstructors _patternsOallValueConstructors _patternsOcollectScopeInfos _patternsOcounter _patternsOlhsPattern _patternsOmiscerrors _patternsOnamesInScope _patternsOtypeConstructors _patternsOvalueConstructors _patternsOwarnings) + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule1811 _lefthandsideInumberOfPatterns _patternsInumberOfPatterns + _patternsOlhsPattern = rule1812 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule1813 _lefthandsideIpatVarNames _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1814 _lefthandsideIunboundNames _patternsIunboundNames + _self = rule1815 _lefthandsideIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule1816 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1817 _patternsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1818 _patternsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1819 _patternsImiscerrors + _lhsOname :: Name + _lhsOname = rule1820 _lefthandsideIname + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1821 _patternsIwarnings + _lefthandsideOallTypeConstructors = rule1822 _lhsIallTypeConstructors + _lefthandsideOallValueConstructors = rule1823 _lhsIallValueConstructors + _lefthandsideOcollectScopeInfos = rule1824 _lhsIcollectScopeInfos + _lefthandsideOcounter = rule1825 _lhsIcounter + _lefthandsideOmiscerrors = rule1826 _lhsImiscerrors + _lefthandsideOnamesInScope = rule1827 _lhsInamesInScope + _lefthandsideOtypeConstructors = rule1828 _lhsItypeConstructors + _lefthandsideOvalueConstructors = rule1829 _lhsIvalueConstructors + _lefthandsideOwarnings = rule1830 _lhsIwarnings + _patternsOallTypeConstructors = rule1831 _lhsIallTypeConstructors + _patternsOallValueConstructors = rule1832 _lhsIallValueConstructors + _patternsOcollectScopeInfos = rule1833 _lefthandsideIcollectScopeInfos + _patternsOcounter = rule1834 _lefthandsideIcounter + _patternsOmiscerrors = rule1835 _lefthandsideImiscerrors + _patternsOnamesInScope = rule1836 _lhsInamesInScope + _patternsOtypeConstructors = rule1837 _lhsItypeConstructors + _patternsOvalueConstructors = rule1838 _lhsIvalueConstructors + _patternsOwarnings = rule1839 _lefthandsideIwarnings + __result_ = T_LeftHandSide_vOut82 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOname _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule1811 #-} + rule1811 = \ ((_lefthandsideInumberOfPatterns) :: Int) ((_patternsInumberOfPatterns) :: Int) -> + _lefthandsideInumberOfPatterns + _patternsInumberOfPatterns + {-# INLINE rule1812 #-} + rule1812 = \ (_ :: ()) -> + False + {-# INLINE rule1813 #-} + rule1813 = \ ((_lefthandsideIpatVarNames) :: Names) ((_patternsIpatVarNames) :: Names) -> + _lefthandsideIpatVarNames ++ _patternsIpatVarNames + {-# INLINE rule1814 #-} + rule1814 = \ ((_lefthandsideIunboundNames) :: Names) ((_patternsIunboundNames) :: Names) -> + _lefthandsideIunboundNames ++ _patternsIunboundNames + {-# INLINE rule1815 #-} + rule1815 = \ ((_lefthandsideIself) :: LeftHandSide) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Parenthesized _rangeIself _lefthandsideIself _patternsIself + {-# INLINE rule1816 #-} + rule1816 = \ _self -> + _self + {-# INLINE rule1817 #-} + rule1817 = \ ((_patternsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternsIcollectScopeInfos + {-# INLINE rule1818 #-} + rule1818 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule1819 #-} + rule1819 = \ ((_patternsImiscerrors) :: [Error]) -> + _patternsImiscerrors + {-# INLINE rule1820 #-} + rule1820 = \ ((_lefthandsideIname) :: Name) -> + _lefthandsideIname + {-# INLINE rule1821 #-} + rule1821 = \ ((_patternsIwarnings) :: [Warning]) -> + _patternsIwarnings + {-# INLINE rule1822 #-} + rule1822 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1823 #-} + rule1823 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1824 #-} + rule1824 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1825 #-} + rule1825 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1826 #-} + rule1826 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1827 #-} + rule1827 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1828 #-} + rule1828 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1829 #-} + rule1829 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1830 #-} + rule1830 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule1831 #-} + rule1831 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1832 #-} + rule1832 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1833 #-} + rule1833 = \ ((_lefthandsideIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lefthandsideIcollectScopeInfos + {-# INLINE rule1834 #-} + rule1834 = \ ((_lefthandsideIcounter) :: Int) -> + _lefthandsideIcounter + {-# INLINE rule1835 #-} + rule1835 = \ ((_lefthandsideImiscerrors) :: [Error]) -> + _lefthandsideImiscerrors + {-# INLINE rule1836 #-} + rule1836 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1837 #-} + rule1837 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1838 #-} + rule1838 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1839 #-} + rule1839 = \ ((_lefthandsideIwarnings) :: [Warning]) -> + _lefthandsideIwarnings + +-- Literal ----------------------------------------------------- +-- wrapper +data Inh_Literal = Inh_Literal { collectScopeInfos_Inh_Literal :: ([(ScopeInfo, Entity)]), miscerrors_Inh_Literal :: ([Error]) } +data Syn_Literal = Syn_Literal { collectScopeInfos_Syn_Literal :: ([(ScopeInfo, Entity)]), miscerrors_Syn_Literal :: ([Error]), self_Syn_Literal :: (Literal) } +{-# INLINABLE wrap_Literal #-} +wrap_Literal :: T_Literal -> Inh_Literal -> (Syn_Literal ) +wrap_Literal (T_Literal act) (Inh_Literal _lhsIcollectScopeInfos _lhsImiscerrors) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Literal_vIn85 _lhsIcollectScopeInfos _lhsImiscerrors + (T_Literal_vOut85 _lhsOcollectScopeInfos _lhsOmiscerrors _lhsOself) <- return (inv_Literal_s86 sem arg) + return (Syn_Literal _lhsOcollectScopeInfos _lhsOmiscerrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Literal #-} +sem_Literal :: Literal -> T_Literal +sem_Literal ( Literal_Int range_ value_ ) = sem_Literal_Int ( sem_Range range_ ) value_ +sem_Literal ( Literal_Char range_ value_ ) = sem_Literal_Char ( sem_Range range_ ) value_ +sem_Literal ( Literal_Float range_ value_ ) = sem_Literal_Float ( sem_Range range_ ) value_ +sem_Literal ( Literal_String range_ value_ ) = sem_Literal_String ( sem_Range range_ ) value_ + +-- semantic domain +newtype T_Literal = T_Literal { + attach_T_Literal :: Identity (T_Literal_s86 ) + } +newtype T_Literal_s86 = C_Literal_s86 { + inv_Literal_s86 :: (T_Literal_v85 ) + } +data T_Literal_s87 = C_Literal_s87 +type T_Literal_v85 = (T_Literal_vIn85 ) -> (T_Literal_vOut85 ) +data T_Literal_vIn85 = T_Literal_vIn85 ([(ScopeInfo, Entity)]) ([Error]) +data T_Literal_vOut85 = T_Literal_vOut85 ([(ScopeInfo, Entity)]) ([Error]) (Literal) +{-# NOINLINE sem_Literal_Int #-} +sem_Literal_Int :: T_Range -> (String) -> T_Literal +sem_Literal_Int arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 _lhsIcollectScopeInfos _lhsImiscerrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _intLiteralTooBigErrors = rule1840 _rangeIself arg_value_ + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1841 _intLiteralTooBigErrors _lhsImiscerrors + _self = rule1842 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule1843 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1844 _lhsIcollectScopeInfos + __result_ = T_Literal_vOut85 _lhsOcollectScopeInfos _lhsOmiscerrors _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule1840 #-} + rule1840 = \ ((_rangeIself) :: Range) value_ -> + let val = read value_ :: Integer in + if length value_ > 9 && (val > maxInt || val < minInt) then + [ IntLiteralTooBig _rangeIself value_ ] + else + [] + {-# INLINE rule1841 #-} + rule1841 = \ _intLiteralTooBigErrors ((_lhsImiscerrors) :: [Error]) -> + _intLiteralTooBigErrors ++ _lhsImiscerrors + {-# INLINE rule1842 #-} + rule1842 = \ ((_rangeIself) :: Range) value_ -> + Literal_Int _rangeIself value_ + {-# INLINE rule1843 #-} + rule1843 = \ _self -> + _self + {-# INLINE rule1844 #-} + rule1844 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos +{-# NOINLINE sem_Literal_Char #-} +sem_Literal_Char :: T_Range -> (String) -> T_Literal +sem_Literal_Char arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 _lhsIcollectScopeInfos _lhsImiscerrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule1845 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule1846 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1847 _lhsIcollectScopeInfos + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1848 _lhsImiscerrors + __result_ = T_Literal_vOut85 _lhsOcollectScopeInfos _lhsOmiscerrors _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule1845 #-} + rule1845 = \ ((_rangeIself) :: Range) value_ -> + Literal_Char _rangeIself value_ + {-# INLINE rule1846 #-} + rule1846 = \ _self -> + _self + {-# INLINE rule1847 #-} + rule1847 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1848 #-} + rule1848 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors +{-# NOINLINE sem_Literal_Float #-} +sem_Literal_Float :: T_Range -> (String) -> T_Literal +sem_Literal_Float arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 _lhsIcollectScopeInfos _lhsImiscerrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule1849 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule1850 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1851 _lhsIcollectScopeInfos + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1852 _lhsImiscerrors + __result_ = T_Literal_vOut85 _lhsOcollectScopeInfos _lhsOmiscerrors _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule1849 #-} + rule1849 = \ ((_rangeIself) :: Range) value_ -> + Literal_Float _rangeIself value_ + {-# INLINE rule1850 #-} + rule1850 = \ _self -> + _self + {-# INLINE rule1851 #-} + rule1851 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1852 #-} + rule1852 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors +{-# NOINLINE sem_Literal_String #-} +sem_Literal_String :: T_Range -> (String) -> T_Literal +sem_Literal_String arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 _lhsIcollectScopeInfos _lhsImiscerrors) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule1853 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule1854 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1855 _lhsIcollectScopeInfos + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1856 _lhsImiscerrors + __result_ = T_Literal_vOut85 _lhsOcollectScopeInfos _lhsOmiscerrors _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule1853 #-} + rule1853 = \ ((_rangeIself) :: Range) value_ -> + Literal_String _rangeIself value_ + {-# INLINE rule1854 #-} + rule1854 = \ _self -> + _self + {-# INLINE rule1855 #-} + rule1855 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1856 #-} + rule1856 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + +-- MaybeDeclarations ------------------------------------------- +-- wrapper +data Inh_MaybeDeclarations = Inh_MaybeDeclarations { allTypeConstructors_Inh_MaybeDeclarations :: (Names), allValueConstructors_Inh_MaybeDeclarations :: (Names), classEnvironment_Inh_MaybeDeclarations :: (ClassEnvironment), collectScopeInfos_Inh_MaybeDeclarations :: ([(ScopeInfo, Entity)]), counter_Inh_MaybeDeclarations :: (Int), kindErrors_Inh_MaybeDeclarations :: ([Error]), miscerrors_Inh_MaybeDeclarations :: ([Error]), namesInScope_Inh_MaybeDeclarations :: (Names), options_Inh_MaybeDeclarations :: ([Option]), orderedTypeSynonyms_Inh_MaybeDeclarations :: (OrderedTypeSynonyms), typeConstructors_Inh_MaybeDeclarations :: (M.Map Name Int), unboundNames_Inh_MaybeDeclarations :: (Names), valueConstructors_Inh_MaybeDeclarations :: (M.Map Name TpScheme), warnings_Inh_MaybeDeclarations :: ([Warning]) } +data Syn_MaybeDeclarations = Syn_MaybeDeclarations { collectInstances_Syn_MaybeDeclarations :: ([(Name, Instance)]), collectScopeInfos_Syn_MaybeDeclarations :: ([(ScopeInfo, Entity)]), counter_Syn_MaybeDeclarations :: (Int), kindErrors_Syn_MaybeDeclarations :: ([Error]), miscerrors_Syn_MaybeDeclarations :: ([Error]), namesInScope_Syn_MaybeDeclarations :: (Names), self_Syn_MaybeDeclarations :: (MaybeDeclarations), unboundNames_Syn_MaybeDeclarations :: (Names), warnings_Syn_MaybeDeclarations :: ([Warning]) } +{-# INLINABLE wrap_MaybeDeclarations #-} +wrap_MaybeDeclarations :: T_MaybeDeclarations -> Inh_MaybeDeclarations -> (Syn_MaybeDeclarations ) +wrap_MaybeDeclarations (T_MaybeDeclarations act) (Inh_MaybeDeclarations _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeDeclarations_vIn88 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings + (T_MaybeDeclarations_vOut88 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_MaybeDeclarations_s89 sem arg) + return (Syn_MaybeDeclarations _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_MaybeDeclarations #-} +sem_MaybeDeclarations :: MaybeDeclarations -> T_MaybeDeclarations +sem_MaybeDeclarations ( MaybeDeclarations_Nothing ) = sem_MaybeDeclarations_Nothing +sem_MaybeDeclarations ( MaybeDeclarations_Just declarations_ ) = sem_MaybeDeclarations_Just ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_MaybeDeclarations = T_MaybeDeclarations { + attach_T_MaybeDeclarations :: Identity (T_MaybeDeclarations_s89 ) + } +newtype T_MaybeDeclarations_s89 = C_MaybeDeclarations_s89 { + inv_MaybeDeclarations_s89 :: (T_MaybeDeclarations_v88 ) + } +data T_MaybeDeclarations_s90 = C_MaybeDeclarations_s90 +type T_MaybeDeclarations_v88 = (T_MaybeDeclarations_vIn88 ) -> (T_MaybeDeclarations_vOut88 ) +data T_MaybeDeclarations_vIn88 = T_MaybeDeclarations_vIn88 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (Names) (M.Map Name TpScheme) ([Warning]) +data T_MaybeDeclarations_vOut88 = T_MaybeDeclarations_vOut88 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) (MaybeDeclarations) (Names) ([Warning]) +{-# NOINLINE sem_MaybeDeclarations_Nothing #-} +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1857 () + _self = rule1858 () + _lhsOself :: MaybeDeclarations + _lhsOself = rule1859 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1860 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1861 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1862 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1863 _lhsImiscerrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule1864 _lhsInamesInScope + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1865 _lhsIunboundNames + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1866 _lhsIwarnings + __result_ = T_MaybeDeclarations_vOut88 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule1857 #-} + rule1857 = \ (_ :: ()) -> + [] + {-# INLINE rule1858 #-} + rule1858 = \ (_ :: ()) -> + MaybeDeclarations_Nothing + {-# INLINE rule1859 #-} + rule1859 = \ _self -> + _self + {-# INLINE rule1860 #-} + rule1860 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1861 #-} + rule1861 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1862 #-} + rule1862 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1863 #-} + rule1863 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1864 #-} + rule1864 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1865 #-} + rule1865 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule1866 #-} + rule1866 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_MaybeDeclarations_Just #-} +sem_MaybeDeclarations_Just :: T_Declarations -> T_MaybeDeclarations +sem_MaybeDeclarations_Just arg_declarations_ = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Declarations_vOut31 _declarationsIcollectInstances _declarationsIcollectScopeInfos _declarationsIcollectTypeConstructors _declarationsIcollectTypeSynonyms _declarationsIcollectValueConstructors _declarationsIcounter _declarationsIdeclVarNames _declarationsIkindErrors _declarationsImiscerrors _declarationsIoperatorFixities _declarationsIpreviousWasAlsoFB _declarationsIrestrictedNames _declarationsIself _declarationsIsuspiciousFBs _declarationsItypeSignatures _declarationsIunboundNames _declarationsIwarnings) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOallTypeConstructors _declarationsOallValueConstructors _declarationsOclassEnvironment _declarationsOcollectScopeInfos _declarationsOcollectTypeConstructors _declarationsOcollectTypeSynonyms _declarationsOcollectValueConstructors _declarationsOcounter _declarationsOkindErrors _declarationsOmiscerrors _declarationsOnamesInScope _declarationsOoperatorFixities _declarationsOoptions _declarationsOorderedTypeSynonyms _declarationsOpreviousWasAlsoFB _declarationsOsuspiciousFBs _declarationsOtypeConstructors _declarationsOtypeSignatures _declarationsOvalueConstructors _declarationsOwarnings) + _declarationsOtypeSignatures = rule1867 () + (_namesInScope,_unboundNames,_scopeInfo) = rule1868 _declarationsIdeclVarNames _declarationsIunboundNames _lhsInamesInScope _lhsIunboundNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1869 _unboundNames + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1870 _declarationsIwarnings _suspiciousErrors + _declarationsOpreviousWasAlsoFB = rule1871 () + _declarationsOsuspiciousFBs = rule1872 () + _suspiciousErrors = rule1873 _declarationsIsuspiciousFBs _declarationsItypeSignatures + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1874 _declarationsImiscerrors _typeSignatureErrors + (_,_doubles) = rule1875 _declarationsItypeSignatures + _typeSignatureErrors = rule1876 _declarationsIdeclVarNames _declarationsIrestrictedNames _declarationsItypeSignatures + (_collectTypeConstructors,_collectValueConstructors,_collectTypeSynonyms,_collectConstructorEnv,_derivedFunctions,_operatorFixities) = rule1877 () + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1878 _declarationsIcollectScopeInfos _scopeInfo + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1879 _declarationsIcollectInstances + _self = rule1880 _declarationsIself + _lhsOself :: MaybeDeclarations + _lhsOself = rule1881 _self + _lhsOcounter :: Int + _lhsOcounter = rule1882 _declarationsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1883 _declarationsIkindErrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule1884 _namesInScope + _declarationsOallTypeConstructors = rule1885 _lhsIallTypeConstructors + _declarationsOallValueConstructors = rule1886 _lhsIallValueConstructors + _declarationsOclassEnvironment = rule1887 _lhsIclassEnvironment + _declarationsOcollectScopeInfos = rule1888 _lhsIcollectScopeInfos + _declarationsOcollectTypeConstructors = rule1889 _collectTypeConstructors + _declarationsOcollectTypeSynonyms = rule1890 _collectTypeSynonyms + _declarationsOcollectValueConstructors = rule1891 _collectValueConstructors + _declarationsOcounter = rule1892 _lhsIcounter + _declarationsOkindErrors = rule1893 _lhsIkindErrors + _declarationsOmiscerrors = rule1894 _lhsImiscerrors + _declarationsOnamesInScope = rule1895 _namesInScope + _declarationsOoperatorFixities = rule1896 _operatorFixities + _declarationsOoptions = rule1897 _lhsIoptions + _declarationsOorderedTypeSynonyms = rule1898 _lhsIorderedTypeSynonyms + _declarationsOtypeConstructors = rule1899 _lhsItypeConstructors + _declarationsOvalueConstructors = rule1900 _lhsIvalueConstructors + _declarationsOwarnings = rule1901 _lhsIwarnings + __result_ = T_MaybeDeclarations_vOut88 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule1867 #-} + rule1867 = \ (_ :: ()) -> + [] + {-# INLINE rule1868 #-} + rule1868 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsIunboundNames) :: Names) -> + changeOfScope _declarationsIdeclVarNames (_declarationsIunboundNames ++ _lhsIunboundNames) _lhsInamesInScope + {-# INLINE rule1869 #-} + rule1869 = \ _unboundNames -> + _unboundNames + {-# INLINE rule1870 #-} + rule1870 = \ ((_declarationsIwarnings) :: [Warning]) _suspiciousErrors -> + _declarationsIwarnings ++ + _suspiciousErrors + {-# INLINE rule1871 #-} + rule1871 = \ (_ :: ()) -> + Nothing + {-# INLINE rule1872 #-} + rule1872 = \ (_ :: ()) -> + [] + {-# INLINE rule1873 #-} + rule1873 = \ ((_declarationsIsuspiciousFBs) :: [(Name,Name)]) ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + findSimilarFunctionBindings _declarationsItypeSignatures _declarationsIsuspiciousFBs + {-# INLINE rule1874 #-} + rule1874 = \ ((_declarationsImiscerrors) :: [Error]) _typeSignatureErrors -> + _typeSignatureErrors ++ _declarationsImiscerrors + {-# INLINE rule1875 #-} + rule1875 = \ ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + uniqueAppearance (map fst _declarationsItypeSignatures) + {-# INLINE rule1876 #-} + rule1876 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIrestrictedNames) :: Names) ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + checkTypeSignatures _declarationsIdeclVarNames _declarationsIrestrictedNames _declarationsItypeSignatures + {-# INLINE rule1877 #-} + rule1877 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "toplevel MaybeDeclaration" + {-# INLINE rule1878 #-} + rule1878 = \ ((_declarationsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) _scopeInfo -> + (_scopeInfo, Definition) : _declarationsIcollectScopeInfos + {-# INLINE rule1879 #-} + rule1879 = \ ((_declarationsIcollectInstances) :: [(Name, Instance)]) -> + _declarationsIcollectInstances + {-# INLINE rule1880 #-} + rule1880 = \ ((_declarationsIself) :: Declarations) -> + MaybeDeclarations_Just _declarationsIself + {-# INLINE rule1881 #-} + rule1881 = \ _self -> + _self + {-# INLINE rule1882 #-} + rule1882 = \ ((_declarationsIcounter) :: Int) -> + _declarationsIcounter + {-# INLINE rule1883 #-} + rule1883 = \ ((_declarationsIkindErrors) :: [Error]) -> + _declarationsIkindErrors + {-# INLINE rule1884 #-} + rule1884 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1885 #-} + rule1885 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1886 #-} + rule1886 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1887 #-} + rule1887 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1888 #-} + rule1888 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1889 #-} + rule1889 = \ _collectTypeConstructors -> + _collectTypeConstructors + {-# INLINE rule1890 #-} + rule1890 = \ _collectTypeSynonyms -> + _collectTypeSynonyms + {-# INLINE rule1891 #-} + rule1891 = \ _collectValueConstructors -> + _collectValueConstructors + {-# INLINE rule1892 #-} + rule1892 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1893 #-} + rule1893 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1894 #-} + rule1894 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1895 #-} + rule1895 = \ _namesInScope -> + _namesInScope + {-# INLINE rule1896 #-} + rule1896 = \ _operatorFixities -> + _operatorFixities + {-# INLINE rule1897 #-} + rule1897 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1898 #-} + rule1898 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1899 #-} + rule1899 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1900 #-} + rule1900 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1901 #-} + rule1901 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- MaybeExports ------------------------------------------------ +-- wrapper +data Inh_MaybeExports = Inh_MaybeExports { consInScope_Inh_MaybeExports :: (Names), modulesInScope_Inh_MaybeExports :: (Names), namesInScop_Inh_MaybeExports :: (Names), tyconsInScope_Inh_MaybeExports :: (Names) } +data Syn_MaybeExports = Syn_MaybeExports { exportErrors_Syn_MaybeExports :: ([Error]), self_Syn_MaybeExports :: (MaybeExports) } +{-# INLINABLE wrap_MaybeExports #-} +wrap_MaybeExports :: T_MaybeExports -> Inh_MaybeExports -> (Syn_MaybeExports ) +wrap_MaybeExports (T_MaybeExports act) (Inh_MaybeExports _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExports_vIn91 _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope + (T_MaybeExports_vOut91 _lhsOexportErrors _lhsOself) <- return (inv_MaybeExports_s92 sem arg) + return (Syn_MaybeExports _lhsOexportErrors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExports #-} +sem_MaybeExports :: MaybeExports -> T_MaybeExports +sem_MaybeExports ( MaybeExports_Nothing ) = sem_MaybeExports_Nothing +sem_MaybeExports ( MaybeExports_Just exports_ ) = sem_MaybeExports_Just ( sem_Exports exports_ ) + +-- semantic domain +newtype T_MaybeExports = T_MaybeExports { + attach_T_MaybeExports :: Identity (T_MaybeExports_s92 ) + } +newtype T_MaybeExports_s92 = C_MaybeExports_s92 { + inv_MaybeExports_s92 :: (T_MaybeExports_v91 ) + } +data T_MaybeExports_s93 = C_MaybeExports_s93 +type T_MaybeExports_v91 = (T_MaybeExports_vIn91 ) -> (T_MaybeExports_vOut91 ) +data T_MaybeExports_vIn91 = T_MaybeExports_vIn91 (Names) (Names) (Names) (Names) +data T_MaybeExports_vOut91 = T_MaybeExports_vOut91 ([Error]) (MaybeExports) +{-# NOINLINE sem_MaybeExports_Nothing #-} +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope) -> ( let + _lhsOexportErrors :: [Error] + _lhsOexportErrors = rule1902 () + _self = rule1903 () + _lhsOself :: MaybeExports + _lhsOself = rule1904 _self + __result_ = T_MaybeExports_vOut91 _lhsOexportErrors _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule1902 #-} + rule1902 = \ (_ :: ()) -> + [] + {-# INLINE rule1903 #-} + rule1903 = \ (_ :: ()) -> + MaybeExports_Nothing + {-# INLINE rule1904 #-} + rule1904 = \ _self -> + _self +{-# NOINLINE sem_MaybeExports_Just #-} +sem_MaybeExports_Just :: T_Exports -> T_MaybeExports +sem_MaybeExports_Just arg_exports_ = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 _lhsIconsInScope _lhsImodulesInScope _lhsInamesInScop _lhsItyconsInScope) -> ( let + _exportsX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_exports_)) + (T_Exports_vOut37 _exportsIexportErrors _exportsIself) = inv_Exports_s38 _exportsX38 (T_Exports_vIn37 _exportsOconsInScope _exportsOmodulesInScope _exportsOnamesInScop _exportsOtyconsInScope) + _lhsOexportErrors :: [Error] + _lhsOexportErrors = rule1905 _exportsIexportErrors + _self = rule1906 _exportsIself + _lhsOself :: MaybeExports + _lhsOself = rule1907 _self + _exportsOconsInScope = rule1908 _lhsIconsInScope + _exportsOmodulesInScope = rule1909 _lhsImodulesInScope + _exportsOnamesInScop = rule1910 _lhsInamesInScop + _exportsOtyconsInScope = rule1911 _lhsItyconsInScope + __result_ = T_MaybeExports_vOut91 _lhsOexportErrors _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule1905 #-} + rule1905 = \ ((_exportsIexportErrors) :: [Error]) -> + _exportsIexportErrors + {-# INLINE rule1906 #-} + rule1906 = \ ((_exportsIself) :: Exports) -> + MaybeExports_Just _exportsIself + {-# INLINE rule1907 #-} + rule1907 = \ _self -> + _self + {-# INLINE rule1908 #-} + rule1908 = \ ((_lhsIconsInScope) :: Names) -> + _lhsIconsInScope + {-# INLINE rule1909 #-} + rule1909 = \ ((_lhsImodulesInScope) :: Names) -> + _lhsImodulesInScope + {-# INLINE rule1910 #-} + rule1910 = \ ((_lhsInamesInScop) :: Names) -> + _lhsInamesInScop + {-# INLINE rule1911 #-} + rule1911 = \ ((_lhsItyconsInScope) :: Names) -> + _lhsItyconsInScope + +-- MaybeExpression --------------------------------------------- +-- wrapper +data Inh_MaybeExpression = Inh_MaybeExpression { allTypeConstructors_Inh_MaybeExpression :: (Names), allValueConstructors_Inh_MaybeExpression :: (Names), classEnvironment_Inh_MaybeExpression :: (ClassEnvironment), collectScopeInfos_Inh_MaybeExpression :: ([(ScopeInfo, Entity)]), counter_Inh_MaybeExpression :: (Int), kindErrors_Inh_MaybeExpression :: ([Error]), miscerrors_Inh_MaybeExpression :: ([Error]), namesInScope_Inh_MaybeExpression :: (Names), options_Inh_MaybeExpression :: ([Option]), orderedTypeSynonyms_Inh_MaybeExpression :: (OrderedTypeSynonyms), typeConstructors_Inh_MaybeExpression :: (M.Map Name Int), valueConstructors_Inh_MaybeExpression :: (M.Map Name TpScheme), warnings_Inh_MaybeExpression :: ([Warning]) } +data Syn_MaybeExpression = Syn_MaybeExpression { collectInstances_Syn_MaybeExpression :: ([(Name, Instance)]), collectScopeInfos_Syn_MaybeExpression :: ([(ScopeInfo, Entity)]), counter_Syn_MaybeExpression :: (Int), kindErrors_Syn_MaybeExpression :: ([Error]), miscerrors_Syn_MaybeExpression :: ([Error]), self_Syn_MaybeExpression :: (MaybeExpression), unboundNames_Syn_MaybeExpression :: (Names), warnings_Syn_MaybeExpression :: ([Warning]) } +{-# INLINABLE wrap_MaybeExpression #-} +wrap_MaybeExpression :: T_MaybeExpression -> Inh_MaybeExpression -> (Syn_MaybeExpression ) +wrap_MaybeExpression (T_MaybeExpression act) (Inh_MaybeExpression _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExpression_vIn94 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_MaybeExpression_vOut94 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_MaybeExpression_s95 sem arg) + return (Syn_MaybeExpression _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_MaybeExpression #-} +sem_MaybeExpression :: MaybeExpression -> T_MaybeExpression +sem_MaybeExpression ( MaybeExpression_Nothing ) = sem_MaybeExpression_Nothing +sem_MaybeExpression ( MaybeExpression_Just expression_ ) = sem_MaybeExpression_Just ( sem_Expression expression_ ) + +-- semantic domain +newtype T_MaybeExpression = T_MaybeExpression { + attach_T_MaybeExpression :: Identity (T_MaybeExpression_s95 ) + } +newtype T_MaybeExpression_s95 = C_MaybeExpression_s95 { + inv_MaybeExpression_s95 :: (T_MaybeExpression_v94 ) + } +data T_MaybeExpression_s96 = C_MaybeExpression_s96 +type T_MaybeExpression_v94 = (T_MaybeExpression_vIn94 ) -> (T_MaybeExpression_vOut94 ) +data T_MaybeExpression_vIn94 = T_MaybeExpression_vIn94 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_MaybeExpression_vOut94 = T_MaybeExpression_vOut94 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (MaybeExpression) (Names) ([Warning]) +{-# NOINLINE sem_MaybeExpression_Nothing #-} +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1912 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1913 () + _self = rule1914 () + _lhsOself :: MaybeExpression + _lhsOself = rule1915 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1916 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1917 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1918 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1919 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1920 _lhsIwarnings + __result_ = T_MaybeExpression_vOut94 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule1912 #-} + rule1912 = \ (_ :: ()) -> + [] + {-# INLINE rule1913 #-} + rule1913 = \ (_ :: ()) -> + [] + {-# INLINE rule1914 #-} + rule1914 = \ (_ :: ()) -> + MaybeExpression_Nothing + {-# INLINE rule1915 #-} + rule1915 = \ _self -> + _self + {-# INLINE rule1916 #-} + rule1916 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1917 #-} + rule1917 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1918 #-} + rule1918 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1919 #-} + rule1919 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1920 #-} + rule1920 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_MaybeExpression_Just #-} +sem_MaybeExpression_Just :: T_Expression -> T_MaybeExpression +sem_MaybeExpression_Just arg_expression_ = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule1921 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule1922 _expressionIunboundNames + _self = rule1923 _expressionIself + _lhsOself :: MaybeExpression + _lhsOself = rule1924 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule1925 _expressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule1926 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule1927 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule1928 _expressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule1929 _expressionIwarnings + _expressionOallTypeConstructors = rule1930 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule1931 _lhsIallValueConstructors + _expressionOclassEnvironment = rule1932 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule1933 _lhsIcollectScopeInfos + _expressionOcounter = rule1934 _lhsIcounter + _expressionOkindErrors = rule1935 _lhsIkindErrors + _expressionOmiscerrors = rule1936 _lhsImiscerrors + _expressionOnamesInScope = rule1937 _lhsInamesInScope + _expressionOoptions = rule1938 _lhsIoptions + _expressionOorderedTypeSynonyms = rule1939 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule1940 _lhsItypeConstructors + _expressionOvalueConstructors = rule1941 _lhsIvalueConstructors + _expressionOwarnings = rule1942 _lhsIwarnings + __result_ = T_MaybeExpression_vOut94 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule1921 #-} + rule1921 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule1922 #-} + rule1922 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule1923 #-} + rule1923 = \ ((_expressionIself) :: Expression) -> + MaybeExpression_Just _expressionIself + {-# INLINE rule1924 #-} + rule1924 = \ _self -> + _self + {-# INLINE rule1925 #-} + rule1925 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule1926 #-} + rule1926 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule1927 #-} + rule1927 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule1928 #-} + rule1928 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule1929 #-} + rule1929 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule1930 #-} + rule1930 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule1931 #-} + rule1931 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule1932 #-} + rule1932 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule1933 #-} + rule1933 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule1934 #-} + rule1934 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule1935 #-} + rule1935 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule1936 #-} + rule1936 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule1937 #-} + rule1937 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule1938 #-} + rule1938 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule1939 #-} + rule1939 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule1940 #-} + rule1940 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule1941 #-} + rule1941 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule1942 #-} + rule1942 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- MaybeImportSpecification ------------------------------------ +-- wrapper +data Inh_MaybeImportSpecification = Inh_MaybeImportSpecification { } +data Syn_MaybeImportSpecification = Syn_MaybeImportSpecification { self_Syn_MaybeImportSpecification :: (MaybeImportSpecification) } +{-# INLINABLE wrap_MaybeImportSpecification #-} +wrap_MaybeImportSpecification :: T_MaybeImportSpecification -> Inh_MaybeImportSpecification -> (Syn_MaybeImportSpecification ) +wrap_MaybeImportSpecification (T_MaybeImportSpecification act) (Inh_MaybeImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeImportSpecification_vIn97 + (T_MaybeImportSpecification_vOut97 _lhsOself) <- return (inv_MaybeImportSpecification_s98 sem arg) + return (Syn_MaybeImportSpecification _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeImportSpecification #-} +sem_MaybeImportSpecification :: MaybeImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification ( MaybeImportSpecification_Nothing ) = sem_MaybeImportSpecification_Nothing +sem_MaybeImportSpecification ( MaybeImportSpecification_Just importspecification_ ) = sem_MaybeImportSpecification_Just ( sem_ImportSpecification importspecification_ ) + +-- semantic domain +newtype T_MaybeImportSpecification = T_MaybeImportSpecification { + attach_T_MaybeImportSpecification :: Identity (T_MaybeImportSpecification_s98 ) + } +newtype T_MaybeImportSpecification_s98 = C_MaybeImportSpecification_s98 { + inv_MaybeImportSpecification_s98 :: (T_MaybeImportSpecification_v97 ) + } +data T_MaybeImportSpecification_s99 = C_MaybeImportSpecification_s99 +type T_MaybeImportSpecification_v97 = (T_MaybeImportSpecification_vIn97 ) -> (T_MaybeImportSpecification_vOut97 ) +data T_MaybeImportSpecification_vIn97 = T_MaybeImportSpecification_vIn97 +data T_MaybeImportSpecification_vOut97 = T_MaybeImportSpecification_vOut97 (MaybeImportSpecification) +{-# NOINLINE sem_MaybeImportSpecification_Nothing #-} +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _self = rule1943 () + _lhsOself :: MaybeImportSpecification + _lhsOself = rule1944 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule1943 #-} + rule1943 = \ (_ :: ()) -> + MaybeImportSpecification_Nothing + {-# INLINE rule1944 #-} + rule1944 = \ _self -> + _self +{-# NOINLINE sem_MaybeImportSpecification_Just #-} +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification_Just arg_importspecification_ = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _importspecificationX77 = Control.Monad.Identity.runIdentity (attach_T_ImportSpecification (arg_importspecification_)) + (T_ImportSpecification_vOut76 _importspecificationIself) = inv_ImportSpecification_s77 _importspecificationX77 (T_ImportSpecification_vIn76 ) + _self = rule1945 _importspecificationIself + _lhsOself :: MaybeImportSpecification + _lhsOself = rule1946 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule1945 #-} + rule1945 = \ ((_importspecificationIself) :: ImportSpecification) -> + MaybeImportSpecification_Just _importspecificationIself + {-# INLINE rule1946 #-} + rule1946 = \ _self -> + _self + +-- MaybeInt ---------------------------------------------------- +-- wrapper +data Inh_MaybeInt = Inh_MaybeInt { } +data Syn_MaybeInt = Syn_MaybeInt { self_Syn_MaybeInt :: (MaybeInt) } +{-# INLINABLE wrap_MaybeInt #-} +wrap_MaybeInt :: T_MaybeInt -> Inh_MaybeInt -> (Syn_MaybeInt ) +wrap_MaybeInt (T_MaybeInt act) (Inh_MaybeInt ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeInt_vIn100 + (T_MaybeInt_vOut100 _lhsOself) <- return (inv_MaybeInt_s101 sem arg) + return (Syn_MaybeInt _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeInt #-} +sem_MaybeInt :: MaybeInt -> T_MaybeInt +sem_MaybeInt ( MaybeInt_Nothing ) = sem_MaybeInt_Nothing +sem_MaybeInt ( MaybeInt_Just int_ ) = sem_MaybeInt_Just int_ + +-- semantic domain +newtype T_MaybeInt = T_MaybeInt { + attach_T_MaybeInt :: Identity (T_MaybeInt_s101 ) + } +newtype T_MaybeInt_s101 = C_MaybeInt_s101 { + inv_MaybeInt_s101 :: (T_MaybeInt_v100 ) + } +data T_MaybeInt_s102 = C_MaybeInt_s102 +type T_MaybeInt_v100 = (T_MaybeInt_vIn100 ) -> (T_MaybeInt_vOut100 ) +data T_MaybeInt_vIn100 = T_MaybeInt_vIn100 +data T_MaybeInt_vOut100 = T_MaybeInt_vOut100 (MaybeInt) +{-# NOINLINE sem_MaybeInt_Nothing #-} +sem_MaybeInt_Nothing :: T_MaybeInt +sem_MaybeInt_Nothing = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule1947 () + _lhsOself :: MaybeInt + _lhsOself = rule1948 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule1947 #-} + rule1947 = \ (_ :: ()) -> + MaybeInt_Nothing + {-# INLINE rule1948 #-} + rule1948 = \ _self -> + _self +{-# NOINLINE sem_MaybeInt_Just #-} +sem_MaybeInt_Just :: (Int) -> T_MaybeInt +sem_MaybeInt_Just arg_int_ = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule1949 arg_int_ + _lhsOself :: MaybeInt + _lhsOself = rule1950 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule1949 #-} + rule1949 = \ int_ -> + MaybeInt_Just int_ + {-# INLINE rule1950 #-} + rule1950 = \ _self -> + _self + +-- MaybeName --------------------------------------------------- +-- wrapper +data Inh_MaybeName = Inh_MaybeName { } +data Syn_MaybeName = Syn_MaybeName { self_Syn_MaybeName :: (MaybeName) } +{-# INLINABLE wrap_MaybeName #-} +wrap_MaybeName :: T_MaybeName -> Inh_MaybeName -> (Syn_MaybeName ) +wrap_MaybeName (T_MaybeName act) (Inh_MaybeName ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeName_vIn103 + (T_MaybeName_vOut103 _lhsOself) <- return (inv_MaybeName_s104 sem arg) + return (Syn_MaybeName _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeName #-} +sem_MaybeName :: MaybeName -> T_MaybeName +sem_MaybeName ( MaybeName_Nothing ) = sem_MaybeName_Nothing +sem_MaybeName ( MaybeName_Just name_ ) = sem_MaybeName_Just ( sem_Name name_ ) + +-- semantic domain +newtype T_MaybeName = T_MaybeName { + attach_T_MaybeName :: Identity (T_MaybeName_s104 ) + } +newtype T_MaybeName_s104 = C_MaybeName_s104 { + inv_MaybeName_s104 :: (T_MaybeName_v103 ) + } +data T_MaybeName_s105 = C_MaybeName_s105 +type T_MaybeName_v103 = (T_MaybeName_vIn103 ) -> (T_MaybeName_vOut103 ) +data T_MaybeName_vIn103 = T_MaybeName_vIn103 +data T_MaybeName_vOut103 = T_MaybeName_vOut103 (MaybeName) +{-# NOINLINE sem_MaybeName_Nothing #-} +sem_MaybeName_Nothing :: T_MaybeName +sem_MaybeName_Nothing = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _self = rule1951 () + _lhsOself :: MaybeName + _lhsOself = rule1952 _self + __result_ = T_MaybeName_vOut103 _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule1951 #-} + rule1951 = \ (_ :: ()) -> + MaybeName_Nothing + {-# INLINE rule1952 #-} + rule1952 = \ _self -> + _self +{-# NOINLINE sem_MaybeName_Just #-} +sem_MaybeName_Just :: T_Name -> T_MaybeName +sem_MaybeName_Just arg_name_ = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule1953 _nameIself + _lhsOself :: MaybeName + _lhsOself = rule1954 _self + __result_ = T_MaybeName_vOut103 _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule1953 #-} + rule1953 = \ ((_nameIself) :: Name) -> + MaybeName_Just _nameIself + {-# INLINE rule1954 #-} + rule1954 = \ _self -> + _self + +-- MaybeNames -------------------------------------------------- +-- wrapper +data Inh_MaybeNames = Inh_MaybeNames { } +data Syn_MaybeNames = Syn_MaybeNames { self_Syn_MaybeNames :: (MaybeNames) } +{-# INLINABLE wrap_MaybeNames #-} +wrap_MaybeNames :: T_MaybeNames -> Inh_MaybeNames -> (Syn_MaybeNames ) +wrap_MaybeNames (T_MaybeNames act) (Inh_MaybeNames ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeNames_vIn106 + (T_MaybeNames_vOut106 _lhsOself) <- return (inv_MaybeNames_s107 sem arg) + return (Syn_MaybeNames _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeNames #-} +sem_MaybeNames :: MaybeNames -> T_MaybeNames +sem_MaybeNames ( MaybeNames_Nothing ) = sem_MaybeNames_Nothing +sem_MaybeNames ( MaybeNames_Just names_ ) = sem_MaybeNames_Just ( sem_Names names_ ) + +-- semantic domain +newtype T_MaybeNames = T_MaybeNames { + attach_T_MaybeNames :: Identity (T_MaybeNames_s107 ) + } +newtype T_MaybeNames_s107 = C_MaybeNames_s107 { + inv_MaybeNames_s107 :: (T_MaybeNames_v106 ) + } +data T_MaybeNames_s108 = C_MaybeNames_s108 +type T_MaybeNames_v106 = (T_MaybeNames_vIn106 ) -> (T_MaybeNames_vOut106 ) +data T_MaybeNames_vIn106 = T_MaybeNames_vIn106 +data T_MaybeNames_vOut106 = T_MaybeNames_vOut106 (MaybeNames) +{-# NOINLINE sem_MaybeNames_Nothing #-} +sem_MaybeNames_Nothing :: T_MaybeNames +sem_MaybeNames_Nothing = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _self = rule1955 () + _lhsOself :: MaybeNames + _lhsOself = rule1956 _self + __result_ = T_MaybeNames_vOut106 _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule1955 #-} + rule1955 = \ (_ :: ()) -> + MaybeNames_Nothing + {-# INLINE rule1956 #-} + rule1956 = \ _self -> + _self +{-# NOINLINE sem_MaybeNames_Just #-} +sem_MaybeNames_Just :: T_Names -> T_MaybeNames +sem_MaybeNames_Just arg_names_ = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + (T_Names_vOut115 _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + _self = rule1957 _namesIself + _lhsOself :: MaybeNames + _lhsOself = rule1958 _self + __result_ = T_MaybeNames_vOut106 _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule1957 #-} + rule1957 = \ ((_namesIself) :: Names) -> + MaybeNames_Just _namesIself + {-# INLINE rule1958 #-} + rule1958 = \ _self -> + _self + +-- Module ------------------------------------------------------ +-- wrapper +data Inh_Module = Inh_Module { baseName_Inh_Module :: (String), importEnvironments_Inh_Module :: (ImportEnvironments), options_Inh_Module :: ([Option]) } +data Syn_Module = Syn_Module { collectEnvironment_Syn_Module :: (ImportEnvironment), errors_Syn_Module :: (Errors), self_Syn_Module :: (Module), typeSignatures_Syn_Module :: ([(Name,TpScheme)]), warnings_Syn_Module :: (Warnings) } +{-# INLINABLE wrap_Module #-} +wrap_Module :: T_Module -> Inh_Module -> (Syn_Module ) +wrap_Module (T_Module act) (Inh_Module _lhsIbaseName _lhsIimportEnvironments _lhsIoptions) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Module_vIn109 _lhsIbaseName _lhsIimportEnvironments _lhsIoptions + (T_Module_vOut109 _lhsOcollectEnvironment _lhsOerrors _lhsOself _lhsOtypeSignatures _lhsOwarnings) <- return (inv_Module_s110 sem arg) + return (Syn_Module _lhsOcollectEnvironment _lhsOerrors _lhsOself _lhsOtypeSignatures _lhsOwarnings) + ) + +-- cata +{-# INLINE sem_Module #-} +sem_Module :: Module -> T_Module +sem_Module ( Module_Module range_ name_ exports_ body_ ) = sem_Module_Module ( sem_Range range_ ) ( sem_MaybeName name_ ) ( sem_MaybeExports exports_ ) ( sem_Body body_ ) + +-- semantic domain +newtype T_Module = T_Module { + attach_T_Module :: Identity (T_Module_s110 ) + } +newtype T_Module_s110 = C_Module_s110 { + inv_Module_s110 :: (T_Module_v109 ) + } +data T_Module_s111 = C_Module_s111 +type T_Module_v109 = (T_Module_vIn109 ) -> (T_Module_vOut109 ) +data T_Module_vIn109 = T_Module_vIn109 (String) (ImportEnvironments) ([Option]) +data T_Module_vOut109 = T_Module_vOut109 (ImportEnvironment) (Errors) (Module) ([(Name,TpScheme)]) (Warnings) +{-# NOINLINE sem_Module_Module #-} +sem_Module_Module :: T_Range -> T_MaybeName -> T_MaybeExports -> T_Body -> T_Module +sem_Module_Module arg_range_ arg_name_ arg_exports_ arg_body_ = T_Module (return st110) where + {-# NOINLINE st110 #-} + st110 = let + v109 :: T_Module_v109 + v109 = \ (T_Module_vIn109 _lhsIbaseName _lhsIimportEnvironments _lhsIoptions) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_name_)) + _exportsX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeExports (arg_exports_)) + _bodyX14 = Control.Monad.Identity.runIdentity (attach_T_Body (arg_body_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeName_vOut103 _nameIself) = inv_MaybeName_s104 _nameX104 (T_MaybeName_vIn103 ) + (T_MaybeExports_vOut91 _exportsIexportErrors _exportsIself) = inv_MaybeExports_s92 _exportsX92 (T_MaybeExports_vIn91 _exportsOconsInScope _exportsOmodulesInScope _exportsOnamesInScop _exportsOtyconsInScope) + (T_Body_vOut13 _bodyIcollectInstances _bodyIcollectScopeInfos _bodyIcollectTypeConstructors _bodyIcollectTypeSynonyms _bodyIcollectValueConstructors _bodyIcounter _bodyIdeclVarNames _bodyIimportedModules _bodyIkindErrors _bodyImiscerrors _bodyIoperatorFixities _bodyIself _bodyItypeSignatures _bodyIunboundNames _bodyIwarnings) = inv_Body_s14 _bodyX14 (T_Body_vIn13 _bodyOallTypeConstructors _bodyOallValueConstructors _bodyOclassEnvironment _bodyOcollectScopeInfos _bodyOcollectTypeConstructors _bodyOcollectTypeSynonyms _bodyOcollectValueConstructors _bodyOcounter _bodyOkindErrors _bodyOmiscerrors _bodyOnamesInScope _bodyOoperatorFixities _bodyOoptions _bodyOorderedTypeSynonyms _bodyOtypeConstructors _bodyOvalueConstructors _bodyOwarnings) + _lhsOerrors :: Errors + _lhsOerrors = rule1959 _allErrors _derivedRanges _removedEntities + _lhsOwarnings :: Warnings + _lhsOwarnings = rule1960 _scopeWarnings _warnings + _allErrors = rule1961 _exportErrors _kindErrors _lhsIoptions _miscerrors _scopeErrors _topLevelErrors + _removedEntities = rule1962 _duplicatedTypeConstructors _duplicatedValueConstructors + _derivedRanges = rule1963 _derivedFunctions + _initialScope = rule1964 _derivedFunctions _lhsIimportEnvironments + _collectEnvironment = rule1965 _bodyIcollectTypeConstructors _bodyIcollectTypeSynonyms _bodyIcollectValueConstructors _bodyIoperatorFixities _derivedFunctions + _derivedFunctions = rule1966 _bodyIcollectTypeConstructors _bodyIcollectTypeSynonyms + _bodyOcollectTypeConstructors = rule1967 () + _bodyOcollectValueConstructors = rule1968 () + _bodyOcollectTypeSynonyms = rule1969 () + _bodyOoperatorFixities = rule1970 () + (_uniqueValueConstructors,_duplicatedValueConstructors) = rule1971 _bodyIcollectValueConstructors _lhsIimportEnvironments + _allValueConstructors = rule1972 _duplicatedValueConstructors _uniqueValueConstructors + _valueConstructors = rule1973 _uniqueValueConstructors + (_uniqueTypeConstructors,_duplicatedTypeConstructors) = rule1974 _bodyIcollectTypeConstructors _bodyIcollectTypeSynonyms _lhsIimportEnvironments + _allTypeConstructors = rule1975 _duplicatedTypeConstructors _uniqueTypeConstructors + _typeConstructors = rule1976 _uniqueTypeConstructors + _bodyOorderedTypeSynonyms = rule1977 _bodyIcollectTypeSynonyms _lhsIimportEnvironments + _bodyOclassEnvironment = rule1978 _bodyIcollectInstances _lhsIimportEnvironments + (_namesInScope,_unboundNames,_scopeInfo) = rule1979 _bodyIdeclVarNames _bodyIunboundNames _initialScope + _bodyOcounter = rule1980 () + _bodyOkindErrors = rule1981 () + _kindErrors = rule1982 _bodyIkindErrors + _bodyOwarnings = rule1983 () + _warnings = rule1984 _bodyIwarnings + _topLevelErrors = rule1985 _fixityButNoFunDefErrors _fixityErrors _recursiveTypeSynonymErrors _typeConstructorErrors _valueConstructorErrors _wrongFileNameErrors _wrongFlagErrors + _typeConstructorErrors = rule1986 _duplicatedTypeConstructors + _valueConstructorErrors = rule1987 _duplicatedValueConstructors + _fixityErrors = rule1988 _duplicatedFixities + (_duplicatedFixities,_correctFixities) = rule1989 _bodyIoperatorFixities + _fixityButNoFunDefErrors = rule1990 _allValueConstructors _bodyIdeclVarNames _correctFixities + _wrongFlagErrors = rule1991 _lhsIimportEnvironments _lhsIoptions + _recursiveTypeSynonymErrors = rule1992 _bodyIcollectTypeSynonyms + _wrongFileNameErrors = rule1993 _lhsIbaseName _moduleName + _moduleName = rule1994 _nameIself + _fileName = rule1995 _lhsIbaseName + _bodyOmiscerrors = rule1996 () + _miscerrors = rule1997 _bodyImiscerrors + _exportsOnamesInScop = rule1998 _bodyIdeclVarNames _derivedFunctions _lhsIimportEnvironments + _exportsOmodulesInScope = rule1999 _bodyIimportedModules _fileName _moduleName + _exportsOtyconsInScope = rule2000 _allTypeConstructors + _exportsOconsInScope = rule2001 _allValueConstructors + _exportErrors = rule2002 _exportsIexportErrors + _bodyOcollectScopeInfos = rule2003 () + _scopeErrors = rule2004 _collectScopeInfos + _scopeWarnings = rule2005 _collectScopeInfos + _collectScopeInfos = rule2006 _bodyIcollectScopeInfos _scopeInfo + _self = rule2007 _bodyIself _exportsIself _nameIself _rangeIself + _lhsOself :: Module + _lhsOself = rule2008 _self + _lhsOcollectEnvironment :: ImportEnvironment + _lhsOcollectEnvironment = rule2009 _collectEnvironment + _lhsOtypeSignatures :: [(Name,TpScheme)] + _lhsOtypeSignatures = rule2010 _bodyItypeSignatures + _bodyOallTypeConstructors = rule2011 _allTypeConstructors + _bodyOallValueConstructors = rule2012 _allValueConstructors + _bodyOnamesInScope = rule2013 _namesInScope + _bodyOoptions = rule2014 _lhsIoptions + _bodyOtypeConstructors = rule2015 _typeConstructors + _bodyOvalueConstructors = rule2016 _valueConstructors + __result_ = T_Module_vOut109 _lhsOcollectEnvironment _lhsOerrors _lhsOself _lhsOtypeSignatures _lhsOwarnings + in __result_ ) + in C_Module_s110 v109 + {-# INLINE rule1959 #-} + rule1959 = \ _allErrors _derivedRanges _removedEntities -> + filter (\err -> filterRemovedNames _removedEntities err + && filterDerivedNames _derivedRanges err) _allErrors + {-# INLINE rule1960 #-} + rule1960 = \ _scopeWarnings _warnings -> + _scopeWarnings ++ _warnings + {-# INLINE rule1961 #-} + rule1961 = \ _exportErrors _kindErrors ((_lhsIoptions) :: [Option]) _miscerrors _scopeErrors _topLevelErrors -> + concat [ _exportErrors + , _scopeErrors + , _miscerrors + , if KindInferencing `elem` _lhsIoptions then [] else _kindErrors + , _topLevelErrors + ] + {-# INLINE rule1962 #-} + rule1962 = \ _duplicatedTypeConstructors _duplicatedValueConstructors -> + [ (name,TypeConstructor) | name:_ <- _duplicatedTypeConstructors ] ++ + [ (name,Constructor ) | name:_ <- _duplicatedValueConstructors ] + {-# INLINE rule1963 #-} + rule1963 = \ _derivedFunctions -> + map getNameRange (map fst _derivedFunctions) + {-# INLINE rule1964 #-} + rule1964 = \ _derivedFunctions ((_lhsIimportEnvironments) :: ImportEnvironments) -> + map fst _derivedFunctions ++ + concatMap (M.keys . typeEnvironment) _lhsIimportEnvironments + {-# INLINE rule1965 #-} + rule1965 = \ ((_bodyIcollectTypeConstructors) :: [(Name,Int)]) ((_bodyIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) ((_bodyIcollectValueConstructors) :: [(Name,TpScheme)]) ((_bodyIoperatorFixities) :: [(Name,(Int,Assoc))]) _derivedFunctions -> + setValueConstructors (M.fromList _bodyIcollectValueConstructors) + . setTypeConstructors (M.fromList _bodyIcollectTypeConstructors) + . setTypeSynonyms (M.fromList _bodyIcollectTypeSynonyms) + . setOperatorTable (M.fromList _bodyIoperatorFixities) + . addToTypeEnvironment (M.fromList _derivedFunctions) + $ emptyEnvironment + {-# INLINE rule1966 #-} + rule1966 = \ ((_bodyIcollectTypeConstructors) :: [(Name,Int)]) ((_bodyIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + let f (n,i) = ( nameOfShowFunction n + , typeOfShowFunction n (take i [ nameFromString s | s <- variableList]) + ) + g (n,(i,_)) = f (n,i) + in map f _bodyIcollectTypeConstructors ++ + map g _bodyIcollectTypeSynonyms + {-# INLINE rule1967 #-} + rule1967 = \ (_ :: ()) -> + [] + {-# INLINE rule1968 #-} + rule1968 = \ (_ :: ()) -> + [] + {-# INLINE rule1969 #-} + rule1969 = \ (_ :: ()) -> + [] + {-# INLINE rule1970 #-} + rule1970 = \ (_ :: ()) -> + [] + {-# INLINE rule1971 #-} + rule1971 = \ ((_bodyIcollectValueConstructors) :: [(Name,TpScheme)]) ((_lhsIimportEnvironments) :: ImportEnvironments) -> + uniqueKeys ( _bodyIcollectValueConstructors + ++ concatMap (M.assocs . valueConstructors) _lhsIimportEnvironments + ) + {-# INLINE rule1972 #-} + rule1972 = \ _duplicatedValueConstructors _uniqueValueConstructors -> + map fst _uniqueValueConstructors ++ map head _duplicatedValueConstructors + {-# INLINE rule1973 #-} + rule1973 = \ _uniqueValueConstructors -> + M.fromList _uniqueValueConstructors + {-# INLINE rule1974 #-} + rule1974 = \ ((_bodyIcollectTypeConstructors) :: [(Name,Int)]) ((_bodyIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) ((_lhsIimportEnvironments) :: ImportEnvironments) -> + uniqueKeys ( _bodyIcollectTypeConstructors + ++ concatMap (M.assocs . typeConstructors) _lhsIimportEnvironments + ++ [ (n,i) | (n,(i,_)) <- _bodyIcollectTypeSynonyms ] + ) + {-# INLINE rule1975 #-} + rule1975 = \ _duplicatedTypeConstructors _uniqueTypeConstructors -> + map fst _uniqueTypeConstructors ++ map head _duplicatedTypeConstructors + {-# INLINE rule1976 #-} + rule1976 = \ _uniqueTypeConstructors -> + M.fromList _uniqueTypeConstructors + {-# INLINE rule1977 #-} + rule1977 = \ ((_bodyIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) ((_lhsIimportEnvironments) :: ImportEnvironments) -> + let list = concatMap (M.assocs . typeSynonyms) _lhsIimportEnvironments ++ + _bodyIcollectTypeSynonyms + newmap = M.fromList [ (show name, t) | (name, t) <- list ] + ordering = fst (getTypeSynonymOrdering newmap) + in (ordering, newmap) + {-# INLINE rule1978 #-} + rule1978 = \ ((_bodyIcollectInstances) :: [(Name, Instance)]) ((_lhsIimportEnvironments) :: ImportEnvironments) -> + let importEnv = foldr combineImportEnvironments emptyEnvironment _lhsIimportEnvironments + in foldr (\(n, i) -> insertInstance (show n) i) + (createClassEnvironment importEnv) + _bodyIcollectInstances + {-# INLINE rule1979 #-} + rule1979 = \ ((_bodyIdeclVarNames) :: Names) ((_bodyIunboundNames) :: Names) _initialScope -> + changeOfScope (_initialScope ++ _bodyIdeclVarNames) _bodyIunboundNames [] + {-# INLINE rule1980 #-} + rule1980 = \ (_ :: ()) -> + 0 + {-# INLINE rule1981 #-} + rule1981 = \ (_ :: ()) -> + [] + {-# INLINE rule1982 #-} + rule1982 = \ ((_bodyIkindErrors) :: [Error]) -> + _bodyIkindErrors + {-# INLINE rule1983 #-} + rule1983 = \ (_ :: ()) -> + [] + {-# INLINE rule1984 #-} + rule1984 = \ ((_bodyIwarnings) :: [Warning]) -> + _bodyIwarnings + {-# INLINE rule1985 #-} + rule1985 = \ _fixityButNoFunDefErrors _fixityErrors _recursiveTypeSynonymErrors _typeConstructorErrors _valueConstructorErrors _wrongFileNameErrors _wrongFlagErrors -> + concat [ _typeConstructorErrors + , _valueConstructorErrors + , _fixityErrors + , _fixityButNoFunDefErrors + , _wrongFlagErrors + , _recursiveTypeSynonymErrors + , _wrongFileNameErrors + ] + {-# INLINE rule1986 #-} + rule1986 = \ _duplicatedTypeConstructors -> + makeDuplicated TypeConstructor _duplicatedTypeConstructors + {-# INLINE rule1987 #-} + rule1987 = \ _duplicatedValueConstructors -> + makeDuplicated Constructor _duplicatedValueConstructors + {-# INLINE rule1988 #-} + rule1988 = \ _duplicatedFixities -> + makeDuplicated Fixity _duplicatedFixities + {-# INLINE rule1989 #-} + rule1989 = \ ((_bodyIoperatorFixities) :: [(Name,(Int,Assoc))]) -> + let (xs,ys) = partition ((>1) . length) . group . sort $ (map fst _bodyIoperatorFixities) + in (xs,map head ys) + {-# INLINE rule1990 #-} + rule1990 = \ _allValueConstructors ((_bodyIdeclVarNames) :: Names) _correctFixities -> + let list = nub (_bodyIdeclVarNames ++ _allValueConstructors) + in makeNoFunDef Fixity (filter (`notElem` list) _correctFixities) list + {-# INLINE rule1991 #-} + rule1991 = \ ((_lhsIimportEnvironments) :: ImportEnvironments) ((_lhsIoptions) :: [Option]) -> + [ WrongOverloadingFlag flag + | let flag = Overloading `elem` _lhsIoptions + imp = any isOverloaded (concatMap (M.elems . typeEnvironment) _lhsIimportEnvironments) + , flag /= imp + ] + {-# INLINE rule1992 #-} + rule1992 = \ ((_bodyIcollectTypeSynonyms) :: [(Name,(Int,Tps -> Tp))]) -> + let converted = map (\(name, tuple) -> (show name, tuple)) _bodyIcollectTypeSynonyms + recursives = snd . getTypeSynonymOrdering . M.fromList $ converted + makeError = let f = foldr add (Just []) + add s ml = case (g s, ml) of + ([n], Just ns) -> Just (n:ns) + _ -> Nothing + g s = [ n | n <- map fst _bodyIcollectTypeSynonyms, show n == s ] + in maybe [] (\x -> [RecursiveTypeSynonyms x]) . f + in concatMap makeError recursives + {-# INLINE rule1993 #-} + rule1993 = \ ((_lhsIbaseName) :: String) _moduleName -> + let moduleString = getNameName _moduleName + moduleRange = getNameRange _moduleName + in if moduleString == "" || _lhsIbaseName == moduleString + then [] + else [ WrongFileName _lhsIbaseName moduleString moduleRange ] + {-# INLINE rule1994 #-} + rule1994 = \ ((_nameIself) :: MaybeName) -> + case _nameIself of + MaybeName_Just name -> name + MaybeName_Nothing -> Name_Identifier noRange [] "" + {-# INLINE rule1995 #-} + rule1995 = \ ((_lhsIbaseName) :: String) -> + Name_Identifier noRange [] _lhsIbaseName + {-# INLINE rule1996 #-} + rule1996 = \ (_ :: ()) -> + [] + {-# INLINE rule1997 #-} + rule1997 = \ ((_bodyImiscerrors) :: [Error]) -> + _bodyImiscerrors + {-# INLINE rule1998 #-} + rule1998 = \ ((_bodyIdeclVarNames) :: Names) _derivedFunctions ((_lhsIimportEnvironments) :: ImportEnvironments) -> + concat [ _bodyIdeclVarNames + , concatMap (M.keys . typeEnvironment) _lhsIimportEnvironments + , map fst _derivedFunctions + ] + {-# INLINE rule1999 #-} + rule1999 = \ ((_bodyIimportedModules) :: Names) _fileName _moduleName -> + (_moduleName : _fileName : _bodyIimportedModules) + {-# INLINE rule2000 #-} + rule2000 = \ _allTypeConstructors -> + _allTypeConstructors + {-# INLINE rule2001 #-} + rule2001 = \ _allValueConstructors -> + _allValueConstructors + {-# INLINE rule2002 #-} + rule2002 = \ ((_exportsIexportErrors) :: [Error]) -> + _exportsIexportErrors + {-# INLINE rule2003 #-} + rule2003 = \ (_ :: ()) -> + [] + {-# INLINE rule2004 #-} + rule2004 = \ _collectScopeInfos -> + makeErrors _collectScopeInfos + {-# INLINE rule2005 #-} + rule2005 = \ _collectScopeInfos -> + makeWarnings _collectScopeInfos + {-# INLINE rule2006 #-} + rule2006 = \ ((_bodyIcollectScopeInfos) :: [(ScopeInfo, Entity)]) _scopeInfo -> + (topLevelScopeInfo _scopeInfo, Definition) : _bodyIcollectScopeInfos + {-# INLINE rule2007 #-} + rule2007 = \ ((_bodyIself) :: Body) ((_exportsIself) :: MaybeExports) ((_nameIself) :: MaybeName) ((_rangeIself) :: Range) -> + Module_Module _rangeIself _nameIself _exportsIself _bodyIself + {-# INLINE rule2008 #-} + rule2008 = \ _self -> + _self + {-# INLINE rule2009 #-} + rule2009 = \ _collectEnvironment -> + _collectEnvironment + {-# INLINE rule2010 #-} + rule2010 = \ ((_bodyItypeSignatures) :: [(Name,TpScheme)]) -> + _bodyItypeSignatures + {-# INLINE rule2011 #-} + rule2011 = \ _allTypeConstructors -> + _allTypeConstructors + {-# INLINE rule2012 #-} + rule2012 = \ _allValueConstructors -> + _allValueConstructors + {-# INLINE rule2013 #-} + rule2013 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2014 #-} + rule2014 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2015 #-} + rule2015 = \ _typeConstructors -> + _typeConstructors + {-# INLINE rule2016 #-} + rule2016 = \ _valueConstructors -> + _valueConstructors + +-- Name -------------------------------------------------------- +-- wrapper +data Inh_Name = Inh_Name { } +data Syn_Name = Syn_Name { self_Syn_Name :: (Name) } +{-# INLINABLE wrap_Name #-} +wrap_Name :: T_Name -> Inh_Name -> (Syn_Name ) +wrap_Name (T_Name act) (Inh_Name ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Name_vIn112 + (T_Name_vOut112 _lhsOself) <- return (inv_Name_s113 sem arg) + return (Syn_Name _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Name #-} +sem_Name :: Name -> T_Name +sem_Name ( Name_Identifier range_ module_ name_ ) = sem_Name_Identifier ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Operator range_ module_ name_ ) = sem_Name_Operator ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Special range_ module_ name_ ) = sem_Name_Special ( sem_Range range_ ) ( sem_Strings module_ ) name_ + +-- semantic domain +newtype T_Name = T_Name { + attach_T_Name :: Identity (T_Name_s113 ) + } +newtype T_Name_s113 = C_Name_s113 { + inv_Name_s113 :: (T_Name_v112 ) + } +data T_Name_s114 = C_Name_s114 +type T_Name_v112 = (T_Name_vIn112 ) -> (T_Name_vOut112 ) +data T_Name_vIn112 = T_Name_vIn112 +data T_Name_vOut112 = T_Name_vOut112 (Name) +{-# NOINLINE sem_Name_Identifier #-} +sem_Name_Identifier :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Identifier arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule2017 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule2018 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule2017 #-} + rule2017 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Identifier _rangeIself _moduleIself name_ + {-# INLINE rule2018 #-} + rule2018 = \ _self -> + _self +{-# NOINLINE sem_Name_Operator #-} +sem_Name_Operator :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Operator arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule2019 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule2020 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule2019 #-} + rule2019 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Operator _rangeIself _moduleIself name_ + {-# INLINE rule2020 #-} + rule2020 = \ _self -> + _self +{-# NOINLINE sem_Name_Special #-} +sem_Name_Special :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Special arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _self = rule2021 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule2022 _self + __result_ = T_Name_vOut112 _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule2021 #-} + rule2021 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Special _rangeIself _moduleIself name_ + {-# INLINE rule2022 #-} + rule2022 = \ _self -> + _self + +-- Names ------------------------------------------------------- +-- wrapper +data Inh_Names = Inh_Names { } +data Syn_Names = Syn_Names { self_Syn_Names :: (Names) } +{-# INLINABLE wrap_Names #-} +wrap_Names :: T_Names -> Inh_Names -> (Syn_Names ) +wrap_Names (T_Names act) (Inh_Names ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Names_vIn115 + (T_Names_vOut115 _lhsOself) <- return (inv_Names_s116 sem arg) + return (Syn_Names _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Names #-} +sem_Names :: Names -> T_Names +sem_Names list = Prelude.foldr sem_Names_Cons sem_Names_Nil (Prelude.map sem_Name list) + +-- semantic domain +newtype T_Names = T_Names { + attach_T_Names :: Identity (T_Names_s116 ) + } +newtype T_Names_s116 = C_Names_s116 { + inv_Names_s116 :: (T_Names_v115 ) + } +data T_Names_s117 = C_Names_s117 +type T_Names_v115 = (T_Names_vIn115 ) -> (T_Names_vOut115 ) +data T_Names_vIn115 = T_Names_vIn115 +data T_Names_vOut115 = T_Names_vOut115 (Names) +{-# NOINLINE sem_Names_Cons #-} +sem_Names_Cons :: T_Name -> T_Names -> T_Names +sem_Names_Cons arg_hd_ arg_tl_ = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _hdX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_hd_)) + _tlX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_tl_)) + (T_Name_vOut112 _hdIself) = inv_Name_s113 _hdX113 (T_Name_vIn112 ) + (T_Names_vOut115 _tlIself) = inv_Names_s116 _tlX116 (T_Names_vIn115 ) + _self = rule2023 _hdIself _tlIself + _lhsOself :: Names + _lhsOself = rule2024 _self + __result_ = T_Names_vOut115 _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule2023 #-} + rule2023 = \ ((_hdIself) :: Name) ((_tlIself) :: Names) -> + (:) _hdIself _tlIself + {-# INLINE rule2024 #-} + rule2024 = \ _self -> + _self +{-# NOINLINE sem_Names_Nil #-} +sem_Names_Nil :: T_Names +sem_Names_Nil = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _self = rule2025 () + _lhsOself :: Names + _lhsOself = rule2026 _self + __result_ = T_Names_vOut115 _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule2025 #-} + rule2025 = \ (_ :: ()) -> + [] + {-# INLINE rule2026 #-} + rule2026 = \ _self -> + _self + +-- Pattern ----------------------------------------------------- +-- wrapper +data Inh_Pattern = Inh_Pattern { allTypeConstructors_Inh_Pattern :: (Names), allValueConstructors_Inh_Pattern :: (Names), collectScopeInfos_Inh_Pattern :: ([(ScopeInfo, Entity)]), counter_Inh_Pattern :: (Int), lhsPattern_Inh_Pattern :: (Bool), miscerrors_Inh_Pattern :: ([Error]), namesInScope_Inh_Pattern :: (Names), typeConstructors_Inh_Pattern :: (M.Map Name Int), valueConstructors_Inh_Pattern :: (M.Map Name TpScheme), warnings_Inh_Pattern :: ([Warning]) } +data Syn_Pattern = Syn_Pattern { collectScopeInfos_Syn_Pattern :: ([(ScopeInfo, Entity)]), counter_Syn_Pattern :: (Int), miscerrors_Syn_Pattern :: ([Error]), patVarNames_Syn_Pattern :: (Names), self_Syn_Pattern :: (Pattern), unboundNames_Syn_Pattern :: (Names), warnings_Syn_Pattern :: ([Warning]) } +{-# INLINABLE wrap_Pattern #-} +wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) +wrap_Pattern (T_Pattern act) (Inh_Pattern _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_Pattern_s119 sem arg) + return (Syn_Pattern _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Pattern #-} +sem_Pattern :: Pattern -> T_Pattern +sem_Pattern ( Pattern_Hole range_ id_ ) = sem_Pattern_Hole ( sem_Range range_ ) id_ +sem_Pattern ( Pattern_Literal range_ literal_ ) = sem_Pattern_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_Variable range_ name_ ) = sem_Pattern_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Pattern ( Pattern_Constructor range_ name_ patterns_ ) = sem_Pattern_Constructor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Parenthesized range_ pattern_ ) = sem_Pattern_Parenthesized ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ ) = sem_Pattern_InfixConstructor ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name constructorOperator_ ) ( sem_Pattern rightPattern_ ) +sem_Pattern ( Pattern_List range_ patterns_ ) = sem_Pattern_List ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Tuple range_ patterns_ ) = sem_Pattern_Tuple ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Record range_ name_ recordPatternBindings_ ) = sem_Pattern_Record ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordPatternBindings recordPatternBindings_ ) +sem_Pattern ( Pattern_Negate range_ literal_ ) = sem_Pattern_Negate ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_As range_ name_ pattern_ ) = sem_Pattern_As ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Wildcard range_ ) = sem_Pattern_Wildcard ( sem_Range range_ ) +sem_Pattern ( Pattern_Irrefutable range_ pattern_ ) = sem_Pattern_Irrefutable ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Successor range_ name_ literal_ ) = sem_Pattern_Successor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_NegateFloat range_ literal_ ) = sem_Pattern_NegateFloat ( sem_Range range_ ) ( sem_Literal literal_ ) + +-- semantic domain +newtype T_Pattern = T_Pattern { + attach_T_Pattern :: Identity (T_Pattern_s119 ) + } +newtype T_Pattern_s119 = C_Pattern_s119 { + inv_Pattern_s119 :: (T_Pattern_v118 ) + } +data T_Pattern_s120 = C_Pattern_s120 +type T_Pattern_v118 = (T_Pattern_vIn118 ) -> (T_Pattern_vOut118 ) +data T_Pattern_vIn118 = T_Pattern_vIn118 (Names) (Names) ([(ScopeInfo, Entity)]) (Int) (Bool) ([Error]) (Names) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_Pattern_vOut118 = T_Pattern_vOut118 ([(ScopeInfo, Entity)]) (Int) ([Error]) (Names) (Pattern) (Names) ([Warning]) +{-# NOINLINE sem_Pattern_Hole #-} +sem_Pattern_Hole :: T_Range -> (Integer) -> T_Pattern +sem_Pattern_Hole arg_range_ arg_id_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2027 _i + _lhsOcounter :: Int + _i :: Int + (_lhsOcounter,_i) = rule2028 _lhsIcounter + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2029 () + _self = rule2030 _rangeIself arg_id_ + _lhsOself :: Pattern + _lhsOself = rule2031 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2032 _lhsIcollectScopeInfos + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2033 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2034 _lhsIwarnings + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2027 #-} + rule2027 = \ ((_i) :: Int) -> + [ Name_Special noRange [] ("hole" ++ show _i ) ] + {-# INLINE rule2028 #-} + rule2028 = \ ((_lhsIcounter) :: Int) -> + let __cont = _lhsIcounter in seq __cont ( case nextUnique __cont of { (__cont, i) -> (__cont,i)} ) + {-# INLINE rule2029 #-} + rule2029 = \ (_ :: ()) -> + [] + {-# INLINE rule2030 #-} + rule2030 = \ ((_rangeIself) :: Range) id_ -> + Pattern_Hole _rangeIself id_ + {-# INLINE rule2031 #-} + rule2031 = \ _self -> + _self + {-# INLINE rule2032 #-} + rule2032 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2033 #-} + rule2033 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2034 #-} + rule2034 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Pattern_Literal #-} +sem_Pattern_Literal :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Literal arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIcollectScopeInfos _literalImiscerrors _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 _literalOcollectScopeInfos _literalOmiscerrors) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2035 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2036 () + _self = rule2037 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2038 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2039 _literalIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2040 _lhsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2041 _literalImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2042 _lhsIwarnings + _literalOcollectScopeInfos = rule2043 _lhsIcollectScopeInfos + _literalOmiscerrors = rule2044 _lhsImiscerrors + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2035 #-} + rule2035 = \ (_ :: ()) -> + [] + {-# INLINE rule2036 #-} + rule2036 = \ (_ :: ()) -> + [] + {-# INLINE rule2037 #-} + rule2037 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Literal _rangeIself _literalIself + {-# INLINE rule2038 #-} + rule2038 = \ _self -> + _self + {-# INLINE rule2039 #-} + rule2039 = \ ((_literalIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _literalIcollectScopeInfos + {-# INLINE rule2040 #-} + rule2040 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2041 #-} + rule2041 = \ ((_literalImiscerrors) :: [Error]) -> + _literalImiscerrors + {-# INLINE rule2042 #-} + rule2042 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2043 #-} + rule2043 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2044 #-} + rule2044 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors +{-# NOINLINE sem_Pattern_Variable #-} +sem_Pattern_Variable :: T_Range -> T_Name -> T_Pattern +sem_Pattern_Variable arg_range_ arg_name_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2045 _nameIself + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2046 () + _self = rule2047 _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2048 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2049 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2050 _lhsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2051 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2052 _lhsIwarnings + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2045 #-} + rule2045 = \ ((_nameIself) :: Name) -> + [ _nameIself ] + {-# INLINE rule2046 #-} + rule2046 = \ (_ :: ()) -> + [] + {-# INLINE rule2047 #-} + rule2047 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Variable _rangeIself _nameIself + {-# INLINE rule2048 #-} + rule2048 = \ _self -> + _self + {-# INLINE rule2049 #-} + rule2049 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2050 #-} + rule2050 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2051 #-} + rule2051 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2052 #-} + rule2052 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Pattern_Constructor #-} +sem_Pattern_Constructor :: T_Range -> T_Name -> T_Patterns -> T_Pattern +sem_Pattern_Constructor arg_range_ arg_name_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIcollectScopeInfos _patternsIcounter _patternsImiscerrors _patternsInumberOfPatterns _patternsIpatVarNames _patternsIself _patternsIunboundNames _patternsIwarnings) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOallTypeConstructors _patternsOallValueConstructors _patternsOcollectScopeInfos _patternsOcounter _patternsOlhsPattern _patternsOmiscerrors _patternsOnamesInScope _patternsOtypeConstructors _patternsOvalueConstructors _patternsOwarnings) + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2053 _patConstructorErrors _patternsImiscerrors + _patConstructorErrors = rule2054 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIlhsPattern _maybetp _nameIself _patternsInumberOfPatterns + _maybetp = rule2055 _lhsIvalueConstructors _nameIself + _patternsOlhsPattern = rule2056 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2057 _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2058 _patternsIunboundNames + _self = rule2059 _nameIself _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2060 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2061 _patternsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2062 _patternsIcounter + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2063 _patternsIwarnings + _patternsOallTypeConstructors = rule2064 _lhsIallTypeConstructors + _patternsOallValueConstructors = rule2065 _lhsIallValueConstructors + _patternsOcollectScopeInfos = rule2066 _lhsIcollectScopeInfos + _patternsOcounter = rule2067 _lhsIcounter + _patternsOmiscerrors = rule2068 _lhsImiscerrors + _patternsOnamesInScope = rule2069 _lhsInamesInScope + _patternsOtypeConstructors = rule2070 _lhsItypeConstructors + _patternsOvalueConstructors = rule2071 _lhsIvalueConstructors + _patternsOwarnings = rule2072 _lhsIwarnings + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2053 #-} + rule2053 = \ _patConstructorErrors ((_patternsImiscerrors) :: [Error]) -> + _patConstructorErrors ++ _patternsImiscerrors + {-# INLINE rule2054 #-} + rule2054 = \ ((_lhsIallTypeConstructors) :: Names) ((_lhsIallValueConstructors) :: Names) ((_lhsIlhsPattern) :: Bool) _maybetp ((_nameIself) :: Name) ((_patternsInumberOfPatterns) :: Int) -> + patternConstructorErrors _maybetp _nameIself _lhsIallValueConstructors _patternsInumberOfPatterns _lhsIlhsPattern _lhsIallTypeConstructors + {-# INLINE rule2055 #-} + rule2055 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) ((_nameIself) :: Name) -> + M.lookup _nameIself _lhsIvalueConstructors + {-# INLINE rule2056 #-} + rule2056 = \ (_ :: ()) -> + False + {-# INLINE rule2057 #-} + rule2057 = \ ((_patternsIpatVarNames) :: Names) -> + _patternsIpatVarNames + {-# INLINE rule2058 #-} + rule2058 = \ ((_patternsIunboundNames) :: Names) -> + _patternsIunboundNames + {-# INLINE rule2059 #-} + rule2059 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Constructor _rangeIself _nameIself _patternsIself + {-# INLINE rule2060 #-} + rule2060 = \ _self -> + _self + {-# INLINE rule2061 #-} + rule2061 = \ ((_patternsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternsIcollectScopeInfos + {-# INLINE rule2062 #-} + rule2062 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule2063 #-} + rule2063 = \ ((_patternsIwarnings) :: [Warning]) -> + _patternsIwarnings + {-# INLINE rule2064 #-} + rule2064 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2065 #-} + rule2065 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2066 #-} + rule2066 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2067 #-} + rule2067 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2068 #-} + rule2068 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2069 #-} + rule2069 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2070 #-} + rule2070 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2071 #-} + rule2071 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2072 #-} + rule2072 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Pattern_Parenthesized #-} +sem_Pattern_Parenthesized :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Parenthesized arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIcollectScopeInfos _patternIcounter _patternImiscerrors _patternIpatVarNames _patternIself _patternIunboundNames _patternIwarnings) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOallTypeConstructors _patternOallValueConstructors _patternOcollectScopeInfos _patternOcounter _patternOlhsPattern _patternOmiscerrors _patternOnamesInScope _patternOtypeConstructors _patternOvalueConstructors _patternOwarnings) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2073 _patternIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2074 _patternIunboundNames + _self = rule2075 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2076 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2077 _patternIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2078 _patternIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2079 _patternImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2080 _patternIwarnings + _patternOallTypeConstructors = rule2081 _lhsIallTypeConstructors + _patternOallValueConstructors = rule2082 _lhsIallValueConstructors + _patternOcollectScopeInfos = rule2083 _lhsIcollectScopeInfos + _patternOcounter = rule2084 _lhsIcounter + _patternOlhsPattern = rule2085 _lhsIlhsPattern + _patternOmiscerrors = rule2086 _lhsImiscerrors + _patternOnamesInScope = rule2087 _lhsInamesInScope + _patternOtypeConstructors = rule2088 _lhsItypeConstructors + _patternOvalueConstructors = rule2089 _lhsIvalueConstructors + _patternOwarnings = rule2090 _lhsIwarnings + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2073 #-} + rule2073 = \ ((_patternIpatVarNames) :: Names) -> + _patternIpatVarNames + {-# INLINE rule2074 #-} + rule2074 = \ ((_patternIunboundNames) :: Names) -> + _patternIunboundNames + {-# INLINE rule2075 #-} + rule2075 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Parenthesized _rangeIself _patternIself + {-# INLINE rule2076 #-} + rule2076 = \ _self -> + _self + {-# INLINE rule2077 #-} + rule2077 = \ ((_patternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternIcollectScopeInfos + {-# INLINE rule2078 #-} + rule2078 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule2079 #-} + rule2079 = \ ((_patternImiscerrors) :: [Error]) -> + _patternImiscerrors + {-# INLINE rule2080 #-} + rule2080 = \ ((_patternIwarnings) :: [Warning]) -> + _patternIwarnings + {-# INLINE rule2081 #-} + rule2081 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2082 #-} + rule2082 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2083 #-} + rule2083 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2084 #-} + rule2084 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2085 #-} + rule2085 = \ ((_lhsIlhsPattern) :: Bool) -> + _lhsIlhsPattern + {-# INLINE rule2086 #-} + rule2086 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2087 #-} + rule2087 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2088 #-} + rule2088 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2089 #-} + rule2089 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2090 #-} + rule2090 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Pattern_InfixConstructor #-} +sem_Pattern_InfixConstructor :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_InfixConstructor arg_range_ arg_leftPattern_ arg_constructorOperator_ arg_rightPattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIcollectScopeInfos _leftPatternIcounter _leftPatternImiscerrors _leftPatternIpatVarNames _leftPatternIself _leftPatternIunboundNames _leftPatternIwarnings) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 _leftPatternOallTypeConstructors _leftPatternOallValueConstructors _leftPatternOcollectScopeInfos _leftPatternOcounter _leftPatternOlhsPattern _leftPatternOmiscerrors _leftPatternOnamesInScope _leftPatternOtypeConstructors _leftPatternOvalueConstructors _leftPatternOwarnings) + (T_Name_vOut112 _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIcollectScopeInfos _rightPatternIcounter _rightPatternImiscerrors _rightPatternIpatVarNames _rightPatternIself _rightPatternIunboundNames _rightPatternIwarnings) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 _rightPatternOallTypeConstructors _rightPatternOallValueConstructors _rightPatternOcollectScopeInfos _rightPatternOcounter _rightPatternOlhsPattern _rightPatternOmiscerrors _rightPatternOnamesInScope _rightPatternOtypeConstructors _rightPatternOvalueConstructors _rightPatternOwarnings) + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2091 _patConstructorErrors _rightPatternImiscerrors + _patConstructorErrors = rule2092 _constructorOperatorIself _lhsIallTypeConstructors _lhsIallValueConstructors _maybetp + _maybetp = rule2093 _constructorOperatorIself _lhsIvalueConstructors + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2094 _leftPatternIpatVarNames _rightPatternIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2095 _leftPatternIunboundNames _rightPatternIunboundNames + _self = rule2096 _constructorOperatorIself _leftPatternIself _rangeIself _rightPatternIself + _lhsOself :: Pattern + _lhsOself = rule2097 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2098 _rightPatternIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2099 _rightPatternIcounter + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2100 _rightPatternIwarnings + _leftPatternOallTypeConstructors = rule2101 _lhsIallTypeConstructors + _leftPatternOallValueConstructors = rule2102 _lhsIallValueConstructors + _leftPatternOcollectScopeInfos = rule2103 _lhsIcollectScopeInfos + _leftPatternOcounter = rule2104 _lhsIcounter + _leftPatternOlhsPattern = rule2105 _lhsIlhsPattern + _leftPatternOmiscerrors = rule2106 _lhsImiscerrors + _leftPatternOnamesInScope = rule2107 _lhsInamesInScope + _leftPatternOtypeConstructors = rule2108 _lhsItypeConstructors + _leftPatternOvalueConstructors = rule2109 _lhsIvalueConstructors + _leftPatternOwarnings = rule2110 _lhsIwarnings + _rightPatternOallTypeConstructors = rule2111 _lhsIallTypeConstructors + _rightPatternOallValueConstructors = rule2112 _lhsIallValueConstructors + _rightPatternOcollectScopeInfos = rule2113 _leftPatternIcollectScopeInfos + _rightPatternOcounter = rule2114 _leftPatternIcounter + _rightPatternOlhsPattern = rule2115 _lhsIlhsPattern + _rightPatternOmiscerrors = rule2116 _leftPatternImiscerrors + _rightPatternOnamesInScope = rule2117 _lhsInamesInScope + _rightPatternOtypeConstructors = rule2118 _lhsItypeConstructors + _rightPatternOvalueConstructors = rule2119 _lhsIvalueConstructors + _rightPatternOwarnings = rule2120 _leftPatternIwarnings + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2091 #-} + rule2091 = \ _patConstructorErrors ((_rightPatternImiscerrors) :: [Error]) -> + _patConstructorErrors ++ _rightPatternImiscerrors + {-# INLINE rule2092 #-} + rule2092 = \ ((_constructorOperatorIself) :: Name) ((_lhsIallTypeConstructors) :: Names) ((_lhsIallValueConstructors) :: Names) _maybetp -> + patternConstructorErrors _maybetp _constructorOperatorIself _lhsIallValueConstructors 2 False _lhsIallTypeConstructors + {-# INLINE rule2093 #-} + rule2093 = \ ((_constructorOperatorIself) :: Name) ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + M.lookup _constructorOperatorIself _lhsIvalueConstructors + {-# INLINE rule2094 #-} + rule2094 = \ ((_leftPatternIpatVarNames) :: Names) ((_rightPatternIpatVarNames) :: Names) -> + _leftPatternIpatVarNames ++ _rightPatternIpatVarNames + {-# INLINE rule2095 #-} + rule2095 = \ ((_leftPatternIunboundNames) :: Names) ((_rightPatternIunboundNames) :: Names) -> + _leftPatternIunboundNames ++ _rightPatternIunboundNames + {-# INLINE rule2096 #-} + rule2096 = \ ((_constructorOperatorIself) :: Name) ((_leftPatternIself) :: Pattern) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + Pattern_InfixConstructor _rangeIself _leftPatternIself _constructorOperatorIself _rightPatternIself + {-# INLINE rule2097 #-} + rule2097 = \ _self -> + _self + {-# INLINE rule2098 #-} + rule2098 = \ ((_rightPatternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _rightPatternIcollectScopeInfos + {-# INLINE rule2099 #-} + rule2099 = \ ((_rightPatternIcounter) :: Int) -> + _rightPatternIcounter + {-# INLINE rule2100 #-} + rule2100 = \ ((_rightPatternIwarnings) :: [Warning]) -> + _rightPatternIwarnings + {-# INLINE rule2101 #-} + rule2101 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2102 #-} + rule2102 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2103 #-} + rule2103 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2104 #-} + rule2104 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2105 #-} + rule2105 = \ ((_lhsIlhsPattern) :: Bool) -> + _lhsIlhsPattern + {-# INLINE rule2106 #-} + rule2106 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2107 #-} + rule2107 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2108 #-} + rule2108 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2109 #-} + rule2109 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2110 #-} + rule2110 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2111 #-} + rule2111 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2112 #-} + rule2112 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2113 #-} + rule2113 = \ ((_leftPatternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _leftPatternIcollectScopeInfos + {-# INLINE rule2114 #-} + rule2114 = \ ((_leftPatternIcounter) :: Int) -> + _leftPatternIcounter + {-# INLINE rule2115 #-} + rule2115 = \ ((_lhsIlhsPattern) :: Bool) -> + _lhsIlhsPattern + {-# INLINE rule2116 #-} + rule2116 = \ ((_leftPatternImiscerrors) :: [Error]) -> + _leftPatternImiscerrors + {-# INLINE rule2117 #-} + rule2117 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2118 #-} + rule2118 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2119 #-} + rule2119 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2120 #-} + rule2120 = \ ((_leftPatternIwarnings) :: [Warning]) -> + _leftPatternIwarnings +{-# NOINLINE sem_Pattern_List #-} +sem_Pattern_List :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_List arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIcollectScopeInfos _patternsIcounter _patternsImiscerrors _patternsInumberOfPatterns _patternsIpatVarNames _patternsIself _patternsIunboundNames _patternsIwarnings) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOallTypeConstructors _patternsOallValueConstructors _patternsOcollectScopeInfos _patternsOcounter _patternsOlhsPattern _patternsOmiscerrors _patternsOnamesInScope _patternsOtypeConstructors _patternsOvalueConstructors _patternsOwarnings) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2121 _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2122 _patternsIunboundNames + _self = rule2123 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2124 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2125 _patternsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2126 _patternsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2127 _patternsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2128 _patternsIwarnings + _patternsOallTypeConstructors = rule2129 _lhsIallTypeConstructors + _patternsOallValueConstructors = rule2130 _lhsIallValueConstructors + _patternsOcollectScopeInfos = rule2131 _lhsIcollectScopeInfos + _patternsOcounter = rule2132 _lhsIcounter + _patternsOlhsPattern = rule2133 _lhsIlhsPattern + _patternsOmiscerrors = rule2134 _lhsImiscerrors + _patternsOnamesInScope = rule2135 _lhsInamesInScope + _patternsOtypeConstructors = rule2136 _lhsItypeConstructors + _patternsOvalueConstructors = rule2137 _lhsIvalueConstructors + _patternsOwarnings = rule2138 _lhsIwarnings + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2121 #-} + rule2121 = \ ((_patternsIpatVarNames) :: Names) -> + _patternsIpatVarNames + {-# INLINE rule2122 #-} + rule2122 = \ ((_patternsIunboundNames) :: Names) -> + _patternsIunboundNames + {-# INLINE rule2123 #-} + rule2123 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_List _rangeIself _patternsIself + {-# INLINE rule2124 #-} + rule2124 = \ _self -> + _self + {-# INLINE rule2125 #-} + rule2125 = \ ((_patternsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternsIcollectScopeInfos + {-# INLINE rule2126 #-} + rule2126 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule2127 #-} + rule2127 = \ ((_patternsImiscerrors) :: [Error]) -> + _patternsImiscerrors + {-# INLINE rule2128 #-} + rule2128 = \ ((_patternsIwarnings) :: [Warning]) -> + _patternsIwarnings + {-# INLINE rule2129 #-} + rule2129 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2130 #-} + rule2130 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2131 #-} + rule2131 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2132 #-} + rule2132 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2133 #-} + rule2133 = \ ((_lhsIlhsPattern) :: Bool) -> + _lhsIlhsPattern + {-# INLINE rule2134 #-} + rule2134 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2135 #-} + rule2135 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2136 #-} + rule2136 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2137 #-} + rule2137 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2138 #-} + rule2138 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Pattern_Tuple #-} +sem_Pattern_Tuple :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_Tuple arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIcollectScopeInfos _patternsIcounter _patternsImiscerrors _patternsInumberOfPatterns _patternsIpatVarNames _patternsIself _patternsIunboundNames _patternsIwarnings) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 _patternsOallTypeConstructors _patternsOallValueConstructors _patternsOcollectScopeInfos _patternsOcounter _patternsOlhsPattern _patternsOmiscerrors _patternsOnamesInScope _patternsOtypeConstructors _patternsOvalueConstructors _patternsOwarnings) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2139 _patternsIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2140 _patternsIunboundNames + _self = rule2141 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2142 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2143 _patternsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2144 _patternsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2145 _patternsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2146 _patternsIwarnings + _patternsOallTypeConstructors = rule2147 _lhsIallTypeConstructors + _patternsOallValueConstructors = rule2148 _lhsIallValueConstructors + _patternsOcollectScopeInfos = rule2149 _lhsIcollectScopeInfos + _patternsOcounter = rule2150 _lhsIcounter + _patternsOlhsPattern = rule2151 _lhsIlhsPattern + _patternsOmiscerrors = rule2152 _lhsImiscerrors + _patternsOnamesInScope = rule2153 _lhsInamesInScope + _patternsOtypeConstructors = rule2154 _lhsItypeConstructors + _patternsOvalueConstructors = rule2155 _lhsIvalueConstructors + _patternsOwarnings = rule2156 _lhsIwarnings + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2139 #-} + rule2139 = \ ((_patternsIpatVarNames) :: Names) -> + _patternsIpatVarNames + {-# INLINE rule2140 #-} + rule2140 = \ ((_patternsIunboundNames) :: Names) -> + _patternsIunboundNames + {-# INLINE rule2141 #-} + rule2141 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Tuple _rangeIself _patternsIself + {-# INLINE rule2142 #-} + rule2142 = \ _self -> + _self + {-# INLINE rule2143 #-} + rule2143 = \ ((_patternsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternsIcollectScopeInfos + {-# INLINE rule2144 #-} + rule2144 = \ ((_patternsIcounter) :: Int) -> + _patternsIcounter + {-# INLINE rule2145 #-} + rule2145 = \ ((_patternsImiscerrors) :: [Error]) -> + _patternsImiscerrors + {-# INLINE rule2146 #-} + rule2146 = \ ((_patternsIwarnings) :: [Warning]) -> + _patternsIwarnings + {-# INLINE rule2147 #-} + rule2147 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2148 #-} + rule2148 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2149 #-} + rule2149 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2150 #-} + rule2150 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2151 #-} + rule2151 = \ ((_lhsIlhsPattern) :: Bool) -> + _lhsIlhsPattern + {-# INLINE rule2152 #-} + rule2152 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2153 #-} + rule2153 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2154 #-} + rule2154 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2155 #-} + rule2155 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2156 #-} + rule2156 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Pattern_Record #-} +sem_Pattern_Record :: T_Range -> T_Name -> T_RecordPatternBindings -> T_Pattern +sem_Pattern_Record arg_range_ arg_name_ arg_recordPatternBindings_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordPatternBindingsX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_recordPatternBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordPatternBindings_vOut145 _recordPatternBindingsIcollectScopeInfos _recordPatternBindingsIcounter _recordPatternBindingsIself _recordPatternBindingsIunboundNames) = inv_RecordPatternBindings_s146 _recordPatternBindingsX146 (T_RecordPatternBindings_vIn145 _recordPatternBindingsOcollectScopeInfos _recordPatternBindingsOcounter _recordPatternBindingsOnamesInScope) + (_beta,_constraints,_environment) = rule2157 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2158 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2159 _recordPatternBindingsIunboundNames + _self = rule2160 _nameIself _rangeIself _recordPatternBindingsIself + _lhsOself :: Pattern + _lhsOself = rule2161 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2162 _recordPatternBindingsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2163 _recordPatternBindingsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2164 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2165 _lhsIwarnings + _recordPatternBindingsOcollectScopeInfos = rule2166 _lhsIcollectScopeInfos + _recordPatternBindingsOcounter = rule2167 _lhsIcounter + _recordPatternBindingsOnamesInScope = rule2168 _lhsInamesInScope + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2157 #-} + rule2157 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "Pattern.Record" + {-# INLINE rule2158 #-} + rule2158 = \ (_ :: ()) -> + [] + {-# INLINE rule2159 #-} + rule2159 = \ ((_recordPatternBindingsIunboundNames) :: Names) -> + _recordPatternBindingsIunboundNames + {-# INLINE rule2160 #-} + rule2160 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordPatternBindingsIself) :: RecordPatternBindings) -> + Pattern_Record _rangeIself _nameIself _recordPatternBindingsIself + {-# INLINE rule2161 #-} + rule2161 = \ _self -> + _self + {-# INLINE rule2162 #-} + rule2162 = \ ((_recordPatternBindingsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _recordPatternBindingsIcollectScopeInfos + {-# INLINE rule2163 #-} + rule2163 = \ ((_recordPatternBindingsIcounter) :: Int) -> + _recordPatternBindingsIcounter + {-# INLINE rule2164 #-} + rule2164 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2165 #-} + rule2165 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2166 #-} + rule2166 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2167 #-} + rule2167 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2168 #-} + rule2168 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope +{-# NOINLINE sem_Pattern_Negate #-} +sem_Pattern_Negate :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Negate arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIcollectScopeInfos _literalImiscerrors _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 _literalOcollectScopeInfos _literalOmiscerrors) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2169 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2170 () + _self = rule2171 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2172 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2173 _literalIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2174 _lhsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2175 _literalImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2176 _lhsIwarnings + _literalOcollectScopeInfos = rule2177 _lhsIcollectScopeInfos + _literalOmiscerrors = rule2178 _lhsImiscerrors + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2169 #-} + rule2169 = \ (_ :: ()) -> + [] + {-# INLINE rule2170 #-} + rule2170 = \ (_ :: ()) -> + [] + {-# INLINE rule2171 #-} + rule2171 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Negate _rangeIself _literalIself + {-# INLINE rule2172 #-} + rule2172 = \ _self -> + _self + {-# INLINE rule2173 #-} + rule2173 = \ ((_literalIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _literalIcollectScopeInfos + {-# INLINE rule2174 #-} + rule2174 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2175 #-} + rule2175 = \ ((_literalImiscerrors) :: [Error]) -> + _literalImiscerrors + {-# INLINE rule2176 #-} + rule2176 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2177 #-} + rule2177 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2178 #-} + rule2178 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors +{-# NOINLINE sem_Pattern_As #-} +sem_Pattern_As :: T_Range -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_As arg_range_ arg_name_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIcollectScopeInfos _patternIcounter _patternImiscerrors _patternIpatVarNames _patternIself _patternIunboundNames _patternIwarnings) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOallTypeConstructors _patternOallValueConstructors _patternOcollectScopeInfos _patternOcounter _patternOlhsPattern _patternOmiscerrors _patternOnamesInScope _patternOtypeConstructors _patternOvalueConstructors _patternOwarnings) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2179 _nameIself _patternIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2180 _patternIunboundNames + _self = rule2181 _nameIself _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2182 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2183 _patternIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2184 _patternIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2185 _patternImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2186 _patternIwarnings + _patternOallTypeConstructors = rule2187 _lhsIallTypeConstructors + _patternOallValueConstructors = rule2188 _lhsIallValueConstructors + _patternOcollectScopeInfos = rule2189 _lhsIcollectScopeInfos + _patternOcounter = rule2190 _lhsIcounter + _patternOlhsPattern = rule2191 _lhsIlhsPattern + _patternOmiscerrors = rule2192 _lhsImiscerrors + _patternOnamesInScope = rule2193 _lhsInamesInScope + _patternOtypeConstructors = rule2194 _lhsItypeConstructors + _patternOvalueConstructors = rule2195 _lhsIvalueConstructors + _patternOwarnings = rule2196 _lhsIwarnings + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2179 #-} + rule2179 = \ ((_nameIself) :: Name) ((_patternIpatVarNames) :: Names) -> + _nameIself : _patternIpatVarNames + {-# INLINE rule2180 #-} + rule2180 = \ ((_patternIunboundNames) :: Names) -> + _patternIunboundNames + {-# INLINE rule2181 #-} + rule2181 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_As _rangeIself _nameIself _patternIself + {-# INLINE rule2182 #-} + rule2182 = \ _self -> + _self + {-# INLINE rule2183 #-} + rule2183 = \ ((_patternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternIcollectScopeInfos + {-# INLINE rule2184 #-} + rule2184 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule2185 #-} + rule2185 = \ ((_patternImiscerrors) :: [Error]) -> + _patternImiscerrors + {-# INLINE rule2186 #-} + rule2186 = \ ((_patternIwarnings) :: [Warning]) -> + _patternIwarnings + {-# INLINE rule2187 #-} + rule2187 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2188 #-} + rule2188 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2189 #-} + rule2189 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2190 #-} + rule2190 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2191 #-} + rule2191 = \ ((_lhsIlhsPattern) :: Bool) -> + _lhsIlhsPattern + {-# INLINE rule2192 #-} + rule2192 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2193 #-} + rule2193 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2194 #-} + rule2194 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2195 #-} + rule2195 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2196 #-} + rule2196 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Pattern_Wildcard #-} +sem_Pattern_Wildcard :: T_Range -> T_Pattern +sem_Pattern_Wildcard arg_range_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2197 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2198 () + _self = rule2199 _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2200 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2201 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2202 _lhsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2203 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2204 _lhsIwarnings + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2197 #-} + rule2197 = \ (_ :: ()) -> + [] + {-# INLINE rule2198 #-} + rule2198 = \ (_ :: ()) -> + [] + {-# INLINE rule2199 #-} + rule2199 = \ ((_rangeIself) :: Range) -> + Pattern_Wildcard _rangeIself + {-# INLINE rule2200 #-} + rule2200 = \ _self -> + _self + {-# INLINE rule2201 #-} + rule2201 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2202 #-} + rule2202 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2203 #-} + rule2203 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2204 #-} + rule2204 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Pattern_Irrefutable #-} +sem_Pattern_Irrefutable :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Irrefutable arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIcollectScopeInfos _patternIcounter _patternImiscerrors _patternIpatVarNames _patternIself _patternIunboundNames _patternIwarnings) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOallTypeConstructors _patternOallValueConstructors _patternOcollectScopeInfos _patternOcounter _patternOlhsPattern _patternOmiscerrors _patternOnamesInScope _patternOtypeConstructors _patternOvalueConstructors _patternOwarnings) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2205 _patternIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2206 _patternIunboundNames + _self = rule2207 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2208 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2209 _patternIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2210 _patternIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2211 _patternImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2212 _patternIwarnings + _patternOallTypeConstructors = rule2213 _lhsIallTypeConstructors + _patternOallValueConstructors = rule2214 _lhsIallValueConstructors + _patternOcollectScopeInfos = rule2215 _lhsIcollectScopeInfos + _patternOcounter = rule2216 _lhsIcounter + _patternOlhsPattern = rule2217 _lhsIlhsPattern + _patternOmiscerrors = rule2218 _lhsImiscerrors + _patternOnamesInScope = rule2219 _lhsInamesInScope + _patternOtypeConstructors = rule2220 _lhsItypeConstructors + _patternOvalueConstructors = rule2221 _lhsIvalueConstructors + _patternOwarnings = rule2222 _lhsIwarnings + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2205 #-} + rule2205 = \ ((_patternIpatVarNames) :: Names) -> + _patternIpatVarNames + {-# INLINE rule2206 #-} + rule2206 = \ ((_patternIunboundNames) :: Names) -> + _patternIunboundNames + {-# INLINE rule2207 #-} + rule2207 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Irrefutable _rangeIself _patternIself + {-# INLINE rule2208 #-} + rule2208 = \ _self -> + _self + {-# INLINE rule2209 #-} + rule2209 = \ ((_patternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternIcollectScopeInfos + {-# INLINE rule2210 #-} + rule2210 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule2211 #-} + rule2211 = \ ((_patternImiscerrors) :: [Error]) -> + _patternImiscerrors + {-# INLINE rule2212 #-} + rule2212 = \ ((_patternIwarnings) :: [Warning]) -> + _patternIwarnings + {-# INLINE rule2213 #-} + rule2213 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2214 #-} + rule2214 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2215 #-} + rule2215 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2216 #-} + rule2216 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2217 #-} + rule2217 = \ ((_lhsIlhsPattern) :: Bool) -> + _lhsIlhsPattern + {-# INLINE rule2218 #-} + rule2218 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2219 #-} + rule2219 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2220 #-} + rule2220 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2221 #-} + rule2221 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2222 #-} + rule2222 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Pattern_Successor #-} +sem_Pattern_Successor :: T_Range -> T_Name -> T_Literal -> T_Pattern +sem_Pattern_Successor arg_range_ arg_name_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Literal_vOut85 _literalIcollectScopeInfos _literalImiscerrors _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 _literalOcollectScopeInfos _literalOmiscerrors) + (_beta,_constraints,_environment) = rule2223 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2224 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2225 () + _self = rule2226 _literalIself _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2227 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2228 _literalIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2229 _lhsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2230 _literalImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2231 _lhsIwarnings + _literalOcollectScopeInfos = rule2232 _lhsIcollectScopeInfos + _literalOmiscerrors = rule2233 _lhsImiscerrors + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2223 #-} + rule2223 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "Pattern.Successor" + {-# INLINE rule2224 #-} + rule2224 = \ (_ :: ()) -> + [] + {-# INLINE rule2225 #-} + rule2225 = \ (_ :: ()) -> + [] + {-# INLINE rule2226 #-} + rule2226 = \ ((_literalIself) :: Literal) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Successor _rangeIself _nameIself _literalIself + {-# INLINE rule2227 #-} + rule2227 = \ _self -> + _self + {-# INLINE rule2228 #-} + rule2228 = \ ((_literalIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _literalIcollectScopeInfos + {-# INLINE rule2229 #-} + rule2229 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2230 #-} + rule2230 = \ ((_literalImiscerrors) :: [Error]) -> + _literalImiscerrors + {-# INLINE rule2231 #-} + rule2231 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2232 #-} + rule2232 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2233 #-} + rule2233 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors +{-# NOINLINE sem_Pattern_NegateFloat #-} +sem_Pattern_NegateFloat :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_NegateFloat arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIcollectScopeInfos _literalImiscerrors _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 _literalOcollectScopeInfos _literalOmiscerrors) + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2234 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2235 () + _self = rule2236 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule2237 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2238 _literalIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2239 _lhsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2240 _literalImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2241 _lhsIwarnings + _literalOcollectScopeInfos = rule2242 _lhsIcollectScopeInfos + _literalOmiscerrors = rule2243 _lhsImiscerrors + __result_ = T_Pattern_vOut118 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule2234 #-} + rule2234 = \ (_ :: ()) -> + [] + {-# INLINE rule2235 #-} + rule2235 = \ (_ :: ()) -> + [] + {-# INLINE rule2236 #-} + rule2236 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_NegateFloat _rangeIself _literalIself + {-# INLINE rule2237 #-} + rule2237 = \ _self -> + _self + {-# INLINE rule2238 #-} + rule2238 = \ ((_literalIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _literalIcollectScopeInfos + {-# INLINE rule2239 #-} + rule2239 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2240 #-} + rule2240 = \ ((_literalImiscerrors) :: [Error]) -> + _literalImiscerrors + {-# INLINE rule2241 #-} + rule2241 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2242 #-} + rule2242 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2243 #-} + rule2243 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + +-- Patterns ---------------------------------------------------- +-- wrapper +data Inh_Patterns = Inh_Patterns { allTypeConstructors_Inh_Patterns :: (Names), allValueConstructors_Inh_Patterns :: (Names), collectScopeInfos_Inh_Patterns :: ([(ScopeInfo, Entity)]), counter_Inh_Patterns :: (Int), lhsPattern_Inh_Patterns :: (Bool), miscerrors_Inh_Patterns :: ([Error]), namesInScope_Inh_Patterns :: (Names), typeConstructors_Inh_Patterns :: (M.Map Name Int), valueConstructors_Inh_Patterns :: (M.Map Name TpScheme), warnings_Inh_Patterns :: ([Warning]) } +data Syn_Patterns = Syn_Patterns { collectScopeInfos_Syn_Patterns :: ([(ScopeInfo, Entity)]), counter_Syn_Patterns :: (Int), miscerrors_Syn_Patterns :: ([Error]), numberOfPatterns_Syn_Patterns :: (Int), patVarNames_Syn_Patterns :: (Names), self_Syn_Patterns :: (Patterns), unboundNames_Syn_Patterns :: (Names), warnings_Syn_Patterns :: ([Warning]) } +{-# INLINABLE wrap_Patterns #-} +wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) +wrap_Patterns (T_Patterns act) (Inh_Patterns _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Patterns_vIn121 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_Patterns_vOut121 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_Patterns_s122 sem arg) + return (Syn_Patterns _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Patterns #-} +sem_Patterns :: Patterns -> T_Patterns +sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) + +-- semantic domain +newtype T_Patterns = T_Patterns { + attach_T_Patterns :: Identity (T_Patterns_s122 ) + } +newtype T_Patterns_s122 = C_Patterns_s122 { + inv_Patterns_s122 :: (T_Patterns_v121 ) + } +data T_Patterns_s123 = C_Patterns_s123 +type T_Patterns_v121 = (T_Patterns_vIn121 ) -> (T_Patterns_vOut121 ) +data T_Patterns_vIn121 = T_Patterns_vIn121 (Names) (Names) ([(ScopeInfo, Entity)]) (Int) (Bool) ([Error]) (Names) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_Patterns_vOut121 = T_Patterns_vOut121 ([(ScopeInfo, Entity)]) (Int) ([Error]) (Int) (Names) (Patterns) (Names) ([Warning]) +{-# NOINLINE sem_Patterns_Cons #-} +sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns +sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _hdX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) + _tlX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) + (T_Pattern_vOut118 _hdIcollectScopeInfos _hdIcounter _hdImiscerrors _hdIpatVarNames _hdIself _hdIunboundNames _hdIwarnings) = inv_Pattern_s119 _hdX119 (T_Pattern_vIn118 _hdOallTypeConstructors _hdOallValueConstructors _hdOcollectScopeInfos _hdOcounter _hdOlhsPattern _hdOmiscerrors _hdOnamesInScope _hdOtypeConstructors _hdOvalueConstructors _hdOwarnings) + (T_Patterns_vOut121 _tlIcollectScopeInfos _tlIcounter _tlImiscerrors _tlInumberOfPatterns _tlIpatVarNames _tlIself _tlIunboundNames _tlIwarnings) = inv_Patterns_s122 _tlX122 (T_Patterns_vIn121 _tlOallTypeConstructors _tlOallValueConstructors _tlOcollectScopeInfos _tlOcounter _tlOlhsPattern _tlOmiscerrors _tlOnamesInScope _tlOtypeConstructors _tlOvalueConstructors _tlOwarnings) + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule2244 _tlInumberOfPatterns + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2245 _hdIpatVarNames _tlIpatVarNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2246 _hdIunboundNames _tlIunboundNames + _self = rule2247 _hdIself _tlIself + _lhsOself :: Patterns + _lhsOself = rule2248 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2249 _tlIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2250 _tlIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2251 _tlImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2252 _tlIwarnings + _hdOallTypeConstructors = rule2253 _lhsIallTypeConstructors + _hdOallValueConstructors = rule2254 _lhsIallValueConstructors + _hdOcollectScopeInfos = rule2255 _lhsIcollectScopeInfos + _hdOcounter = rule2256 _lhsIcounter + _hdOlhsPattern = rule2257 _lhsIlhsPattern + _hdOmiscerrors = rule2258 _lhsImiscerrors + _hdOnamesInScope = rule2259 _lhsInamesInScope + _hdOtypeConstructors = rule2260 _lhsItypeConstructors + _hdOvalueConstructors = rule2261 _lhsIvalueConstructors + _hdOwarnings = rule2262 _lhsIwarnings + _tlOallTypeConstructors = rule2263 _lhsIallTypeConstructors + _tlOallValueConstructors = rule2264 _lhsIallValueConstructors + _tlOcollectScopeInfos = rule2265 _hdIcollectScopeInfos + _tlOcounter = rule2266 _hdIcounter + _tlOlhsPattern = rule2267 _lhsIlhsPattern + _tlOmiscerrors = rule2268 _hdImiscerrors + _tlOnamesInScope = rule2269 _lhsInamesInScope + _tlOtypeConstructors = rule2270 _lhsItypeConstructors + _tlOvalueConstructors = rule2271 _lhsIvalueConstructors + _tlOwarnings = rule2272 _hdIwarnings + __result_ = T_Patterns_vOut121 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule2244 #-} + rule2244 = \ ((_tlInumberOfPatterns) :: Int) -> + 1 + _tlInumberOfPatterns + {-# INLINE rule2245 #-} + rule2245 = \ ((_hdIpatVarNames) :: Names) ((_tlIpatVarNames) :: Names) -> + _hdIpatVarNames ++ _tlIpatVarNames + {-# INLINE rule2246 #-} + rule2246 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule2247 #-} + rule2247 = \ ((_hdIself) :: Pattern) ((_tlIself) :: Patterns) -> + (:) _hdIself _tlIself + {-# INLINE rule2248 #-} + rule2248 = \ _self -> + _self + {-# INLINE rule2249 #-} + rule2249 = \ ((_tlIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _tlIcollectScopeInfos + {-# INLINE rule2250 #-} + rule2250 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule2251 #-} + rule2251 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule2252 #-} + rule2252 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule2253 #-} + rule2253 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2254 #-} + rule2254 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2255 #-} + rule2255 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2256 #-} + rule2256 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2257 #-} + rule2257 = \ ((_lhsIlhsPattern) :: Bool) -> + _lhsIlhsPattern + {-# INLINE rule2258 #-} + rule2258 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2259 #-} + rule2259 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2260 #-} + rule2260 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2261 #-} + rule2261 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2262 #-} + rule2262 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2263 #-} + rule2263 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2264 #-} + rule2264 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2265 #-} + rule2265 = \ ((_hdIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _hdIcollectScopeInfos + {-# INLINE rule2266 #-} + rule2266 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule2267 #-} + rule2267 = \ ((_lhsIlhsPattern) :: Bool) -> + _lhsIlhsPattern + {-# INLINE rule2268 #-} + rule2268 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule2269 #-} + rule2269 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2270 #-} + rule2270 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2271 #-} + rule2271 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2272 #-} + rule2272 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_Patterns_Nil #-} +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIcollectScopeInfos _lhsIcounter _lhsIlhsPattern _lhsImiscerrors _lhsInamesInScope _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOnumberOfPatterns :: Int + _lhsOnumberOfPatterns = rule2273 () + _lhsOpatVarNames :: Names + _lhsOpatVarNames = rule2274 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2275 () + _self = rule2276 () + _lhsOself :: Patterns + _lhsOself = rule2277 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2278 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2279 _lhsIcounter + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2280 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2281 _lhsIwarnings + __result_ = T_Patterns_vOut121 _lhsOcollectScopeInfos _lhsOcounter _lhsOmiscerrors _lhsOnumberOfPatterns _lhsOpatVarNames _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule2273 #-} + rule2273 = \ (_ :: ()) -> + 0 + {-# INLINE rule2274 #-} + rule2274 = \ (_ :: ()) -> + [] + {-# INLINE rule2275 #-} + rule2275 = \ (_ :: ()) -> + [] + {-# INLINE rule2276 #-} + rule2276 = \ (_ :: ()) -> + [] + {-# INLINE rule2277 #-} + rule2277 = \ _self -> + _self + {-# INLINE rule2278 #-} + rule2278 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2279 #-} + rule2279 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2280 #-} + rule2280 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2281 #-} + rule2281 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Position ---------------------------------------------------- +-- wrapper +data Inh_Position = Inh_Position { } +data Syn_Position = Syn_Position { self_Syn_Position :: (Position) } +{-# INLINABLE wrap_Position #-} +wrap_Position :: T_Position -> Inh_Position -> (Syn_Position ) +wrap_Position (T_Position act) (Inh_Position ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Position_vIn124 + (T_Position_vOut124 _lhsOself) <- return (inv_Position_s125 sem arg) + return (Syn_Position _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Position #-} +sem_Position :: Position -> T_Position +sem_Position ( Position_Position filename_ line_ column_ ) = sem_Position_Position filename_ line_ column_ +sem_Position ( Position_Unknown ) = sem_Position_Unknown + +-- semantic domain +newtype T_Position = T_Position { + attach_T_Position :: Identity (T_Position_s125 ) + } +newtype T_Position_s125 = C_Position_s125 { + inv_Position_s125 :: (T_Position_v124 ) + } +data T_Position_s126 = C_Position_s126 +type T_Position_v124 = (T_Position_vIn124 ) -> (T_Position_vOut124 ) +data T_Position_vIn124 = T_Position_vIn124 +data T_Position_vOut124 = T_Position_vOut124 (Position) +{-# NOINLINE sem_Position_Position #-} +sem_Position_Position :: (String) -> (Int) -> (Int) -> T_Position +sem_Position_Position arg_filename_ arg_line_ arg_column_ = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule2282 arg_column_ arg_filename_ arg_line_ + _lhsOself :: Position + _lhsOself = rule2283 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule2282 #-} + rule2282 = \ column_ filename_ line_ -> + Position_Position filename_ line_ column_ + {-# INLINE rule2283 #-} + rule2283 = \ _self -> + _self +{-# NOINLINE sem_Position_Unknown #-} +sem_Position_Unknown :: T_Position +sem_Position_Unknown = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule2284 () + _lhsOself :: Position + _lhsOself = rule2285 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule2284 #-} + rule2284 = \ (_ :: ()) -> + Position_Unknown + {-# INLINE rule2285 #-} + rule2285 = \ _self -> + _self + +-- Qualifier --------------------------------------------------- +-- wrapper +data Inh_Qualifier = Inh_Qualifier { allTypeConstructors_Inh_Qualifier :: (Names), allValueConstructors_Inh_Qualifier :: (Names), classEnvironment_Inh_Qualifier :: (ClassEnvironment), collectScopeInfos_Inh_Qualifier :: ([(ScopeInfo, Entity)]), counter_Inh_Qualifier :: (Int), kindErrors_Inh_Qualifier :: ([Error]), miscerrors_Inh_Qualifier :: ([Error]), namesInScope_Inh_Qualifier :: (Names), options_Inh_Qualifier :: ([Option]), orderedTypeSynonyms_Inh_Qualifier :: (OrderedTypeSynonyms), typeConstructors_Inh_Qualifier :: (M.Map Name Int), unboundNames_Inh_Qualifier :: (Names), valueConstructors_Inh_Qualifier :: (M.Map Name TpScheme), warnings_Inh_Qualifier :: ([Warning]) } +data Syn_Qualifier = Syn_Qualifier { collectInstances_Syn_Qualifier :: ([(Name, Instance)]), collectScopeInfos_Syn_Qualifier :: ([(ScopeInfo, Entity)]), counter_Syn_Qualifier :: (Int), kindErrors_Syn_Qualifier :: ([Error]), miscerrors_Syn_Qualifier :: ([Error]), namesInScope_Syn_Qualifier :: (Names), self_Syn_Qualifier :: (Qualifier), unboundNames_Syn_Qualifier :: (Names), warnings_Syn_Qualifier :: ([Warning]) } +{-# INLINABLE wrap_Qualifier #-} +wrap_Qualifier :: T_Qualifier -> Inh_Qualifier -> (Syn_Qualifier ) +wrap_Qualifier (T_Qualifier act) (Inh_Qualifier _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifier_vIn127 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings + (T_Qualifier_vOut127 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_Qualifier_s128 sem arg) + return (Syn_Qualifier _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Qualifier #-} +sem_Qualifier :: Qualifier -> T_Qualifier +sem_Qualifier ( Qualifier_Guard range_ guard_ ) = sem_Qualifier_Guard ( sem_Range range_ ) ( sem_Expression guard_ ) +sem_Qualifier ( Qualifier_Let range_ declarations_ ) = sem_Qualifier_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Qualifier ( Qualifier_Generator range_ pattern_ expression_ ) = sem_Qualifier_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Qualifier ( Qualifier_Empty range_ ) = sem_Qualifier_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Qualifier = T_Qualifier { + attach_T_Qualifier :: Identity (T_Qualifier_s128 ) + } +newtype T_Qualifier_s128 = C_Qualifier_s128 { + inv_Qualifier_s128 :: (T_Qualifier_v127 ) + } +data T_Qualifier_s129 = C_Qualifier_s129 +type T_Qualifier_v127 = (T_Qualifier_vIn127 ) -> (T_Qualifier_vOut127 ) +data T_Qualifier_vIn127 = T_Qualifier_vIn127 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (Names) (M.Map Name TpScheme) ([Warning]) +data T_Qualifier_vOut127 = T_Qualifier_vOut127 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) (Qualifier) (Names) ([Warning]) +{-# NOINLINE sem_Qualifier_Guard #-} +sem_Qualifier_Guard :: T_Range -> T_Expression -> T_Qualifier +sem_Qualifier_Guard arg_range_ arg_guard_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIcollectInstances _guardIcollectScopeInfos _guardIcounter _guardIkindErrors _guardImiscerrors _guardIself _guardIunboundNames _guardIwarnings) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 _guardOallTypeConstructors _guardOallValueConstructors _guardOclassEnvironment _guardOcollectScopeInfos _guardOcounter _guardOkindErrors _guardOmiscerrors _guardOnamesInScope _guardOoptions _guardOorderedTypeSynonyms _guardOtypeConstructors _guardOvalueConstructors _guardOwarnings) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2286 _guardIunboundNames _lhsIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2287 _guardIcollectInstances + _self = rule2288 _guardIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule2289 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2290 _guardIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2291 _guardIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2292 _guardIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2293 _guardImiscerrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2294 _lhsInamesInScope + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2295 _guardIwarnings + _guardOallTypeConstructors = rule2296 _lhsIallTypeConstructors + _guardOallValueConstructors = rule2297 _lhsIallValueConstructors + _guardOclassEnvironment = rule2298 _lhsIclassEnvironment + _guardOcollectScopeInfos = rule2299 _lhsIcollectScopeInfos + _guardOcounter = rule2300 _lhsIcounter + _guardOkindErrors = rule2301 _lhsIkindErrors + _guardOmiscerrors = rule2302 _lhsImiscerrors + _guardOnamesInScope = rule2303 _lhsInamesInScope + _guardOoptions = rule2304 _lhsIoptions + _guardOorderedTypeSynonyms = rule2305 _lhsIorderedTypeSynonyms + _guardOtypeConstructors = rule2306 _lhsItypeConstructors + _guardOvalueConstructors = rule2307 _lhsIvalueConstructors + _guardOwarnings = rule2308 _lhsIwarnings + __result_ = T_Qualifier_vOut127 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule2286 #-} + rule2286 = \ ((_guardIunboundNames) :: Names) ((_lhsIunboundNames) :: Names) -> + _guardIunboundNames ++ _lhsIunboundNames + {-# INLINE rule2287 #-} + rule2287 = \ ((_guardIcollectInstances) :: [(Name, Instance)]) -> + _guardIcollectInstances + {-# INLINE rule2288 #-} + rule2288 = \ ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + Qualifier_Guard _rangeIself _guardIself + {-# INLINE rule2289 #-} + rule2289 = \ _self -> + _self + {-# INLINE rule2290 #-} + rule2290 = \ ((_guardIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _guardIcollectScopeInfos + {-# INLINE rule2291 #-} + rule2291 = \ ((_guardIcounter) :: Int) -> + _guardIcounter + {-# INLINE rule2292 #-} + rule2292 = \ ((_guardIkindErrors) :: [Error]) -> + _guardIkindErrors + {-# INLINE rule2293 #-} + rule2293 = \ ((_guardImiscerrors) :: [Error]) -> + _guardImiscerrors + {-# INLINE rule2294 #-} + rule2294 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2295 #-} + rule2295 = \ ((_guardIwarnings) :: [Warning]) -> + _guardIwarnings + {-# INLINE rule2296 #-} + rule2296 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2297 #-} + rule2297 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2298 #-} + rule2298 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2299 #-} + rule2299 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2300 #-} + rule2300 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2301 #-} + rule2301 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2302 #-} + rule2302 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2303 #-} + rule2303 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2304 #-} + rule2304 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2305 #-} + rule2305 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2306 #-} + rule2306 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2307 #-} + rule2307 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2308 #-} + rule2308 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Qualifier_Let #-} +sem_Qualifier_Let :: T_Range -> T_Declarations -> T_Qualifier +sem_Qualifier_Let arg_range_ arg_declarations_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIcollectInstances _declarationsIcollectScopeInfos _declarationsIcollectTypeConstructors _declarationsIcollectTypeSynonyms _declarationsIcollectValueConstructors _declarationsIcounter _declarationsIdeclVarNames _declarationsIkindErrors _declarationsImiscerrors _declarationsIoperatorFixities _declarationsIpreviousWasAlsoFB _declarationsIrestrictedNames _declarationsIself _declarationsIsuspiciousFBs _declarationsItypeSignatures _declarationsIunboundNames _declarationsIwarnings) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOallTypeConstructors _declarationsOallValueConstructors _declarationsOclassEnvironment _declarationsOcollectScopeInfos _declarationsOcollectTypeConstructors _declarationsOcollectTypeSynonyms _declarationsOcollectValueConstructors _declarationsOcounter _declarationsOkindErrors _declarationsOmiscerrors _declarationsOnamesInScope _declarationsOoperatorFixities _declarationsOoptions _declarationsOorderedTypeSynonyms _declarationsOpreviousWasAlsoFB _declarationsOsuspiciousFBs _declarationsOtypeConstructors _declarationsOtypeSignatures _declarationsOvalueConstructors _declarationsOwarnings) + _declarationsOtypeSignatures = rule2309 () + (_namesInScope,_unboundNames,_scopeInfo) = rule2310 _declarationsIdeclVarNames _declarationsIunboundNames _lhsInamesInScope _lhsIunboundNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2311 _unboundNames + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2312 _declarationsIwarnings _suspiciousErrors + _declarationsOpreviousWasAlsoFB = rule2313 () + _declarationsOsuspiciousFBs = rule2314 () + _suspiciousErrors = rule2315 _declarationsIsuspiciousFBs _declarationsItypeSignatures + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2316 _declarationsImiscerrors _typeSignatureErrors + (_,_doubles) = rule2317 _declarationsItypeSignatures + _typeSignatureErrors = rule2318 _declarationsIdeclVarNames _declarationsIrestrictedNames _declarationsItypeSignatures + (_collectTypeConstructors,_collectValueConstructors,_collectTypeSynonyms,_collectConstructorEnv,_derivedFunctions,_operatorFixities) = rule2319 () + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2320 _declarationsIcollectScopeInfos _scopeInfo + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2321 _declarationsIcollectInstances + _self = rule2322 _declarationsIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule2323 _self + _lhsOcounter :: Int + _lhsOcounter = rule2324 _declarationsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2325 _declarationsIkindErrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2326 _namesInScope + _declarationsOallTypeConstructors = rule2327 _lhsIallTypeConstructors + _declarationsOallValueConstructors = rule2328 _lhsIallValueConstructors + _declarationsOclassEnvironment = rule2329 _lhsIclassEnvironment + _declarationsOcollectScopeInfos = rule2330 _lhsIcollectScopeInfos + _declarationsOcollectTypeConstructors = rule2331 _collectTypeConstructors + _declarationsOcollectTypeSynonyms = rule2332 _collectTypeSynonyms + _declarationsOcollectValueConstructors = rule2333 _collectValueConstructors + _declarationsOcounter = rule2334 _lhsIcounter + _declarationsOkindErrors = rule2335 _lhsIkindErrors + _declarationsOmiscerrors = rule2336 _lhsImiscerrors + _declarationsOnamesInScope = rule2337 _namesInScope + _declarationsOoperatorFixities = rule2338 _operatorFixities + _declarationsOoptions = rule2339 _lhsIoptions + _declarationsOorderedTypeSynonyms = rule2340 _lhsIorderedTypeSynonyms + _declarationsOtypeConstructors = rule2341 _lhsItypeConstructors + _declarationsOvalueConstructors = rule2342 _lhsIvalueConstructors + _declarationsOwarnings = rule2343 _lhsIwarnings + __result_ = T_Qualifier_vOut127 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule2309 #-} + rule2309 = \ (_ :: ()) -> + [] + {-# INLINE rule2310 #-} + rule2310 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsIunboundNames) :: Names) -> + changeOfScope _declarationsIdeclVarNames (_declarationsIunboundNames ++ _lhsIunboundNames) _lhsInamesInScope + {-# INLINE rule2311 #-} + rule2311 = \ _unboundNames -> + _unboundNames + {-# INLINE rule2312 #-} + rule2312 = \ ((_declarationsIwarnings) :: [Warning]) _suspiciousErrors -> + _declarationsIwarnings ++ + _suspiciousErrors + {-# INLINE rule2313 #-} + rule2313 = \ (_ :: ()) -> + Nothing + {-# INLINE rule2314 #-} + rule2314 = \ (_ :: ()) -> + [] + {-# INLINE rule2315 #-} + rule2315 = \ ((_declarationsIsuspiciousFBs) :: [(Name,Name)]) ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + findSimilarFunctionBindings _declarationsItypeSignatures _declarationsIsuspiciousFBs + {-# INLINE rule2316 #-} + rule2316 = \ ((_declarationsImiscerrors) :: [Error]) _typeSignatureErrors -> + _typeSignatureErrors ++ _declarationsImiscerrors + {-# INLINE rule2317 #-} + rule2317 = \ ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + uniqueAppearance (map fst _declarationsItypeSignatures) + {-# INLINE rule2318 #-} + rule2318 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIrestrictedNames) :: Names) ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + checkTypeSignatures _declarationsIdeclVarNames _declarationsIrestrictedNames _declarationsItypeSignatures + {-# INLINE rule2319 #-} + rule2319 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "toplevel Qualifier" + {-# INLINE rule2320 #-} + rule2320 = \ ((_declarationsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) _scopeInfo -> + (_scopeInfo, Definition) : _declarationsIcollectScopeInfos + {-# INLINE rule2321 #-} + rule2321 = \ ((_declarationsIcollectInstances) :: [(Name, Instance)]) -> + _declarationsIcollectInstances + {-# INLINE rule2322 #-} + rule2322 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Qualifier_Let _rangeIself _declarationsIself + {-# INLINE rule2323 #-} + rule2323 = \ _self -> + _self + {-# INLINE rule2324 #-} + rule2324 = \ ((_declarationsIcounter) :: Int) -> + _declarationsIcounter + {-# INLINE rule2325 #-} + rule2325 = \ ((_declarationsIkindErrors) :: [Error]) -> + _declarationsIkindErrors + {-# INLINE rule2326 #-} + rule2326 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2327 #-} + rule2327 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2328 #-} + rule2328 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2329 #-} + rule2329 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2330 #-} + rule2330 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2331 #-} + rule2331 = \ _collectTypeConstructors -> + _collectTypeConstructors + {-# INLINE rule2332 #-} + rule2332 = \ _collectTypeSynonyms -> + _collectTypeSynonyms + {-# INLINE rule2333 #-} + rule2333 = \ _collectValueConstructors -> + _collectValueConstructors + {-# INLINE rule2334 #-} + rule2334 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2335 #-} + rule2335 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2336 #-} + rule2336 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2337 #-} + rule2337 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2338 #-} + rule2338 = \ _operatorFixities -> + _operatorFixities + {-# INLINE rule2339 #-} + rule2339 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2340 #-} + rule2340 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2341 #-} + rule2341 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2342 #-} + rule2342 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2343 #-} + rule2343 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Qualifier_Generator #-} +sem_Qualifier_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Qualifier +sem_Qualifier_Generator arg_range_ arg_pattern_ arg_expression_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIcollectScopeInfos _patternIcounter _patternImiscerrors _patternIpatVarNames _patternIself _patternIunboundNames _patternIwarnings) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOallTypeConstructors _patternOallValueConstructors _patternOcollectScopeInfos _patternOcounter _patternOlhsPattern _patternOmiscerrors _patternOnamesInScope _patternOtypeConstructors _patternOvalueConstructors _patternOwarnings) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + (_namesInScope,_unboundNames,_scopeInfo) = rule2344 _expressionIunboundNames _lhsInamesInScope _lhsIunboundNames _patternIpatVarNames + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2345 _namesInScope + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2346 _unboundNames + _expressionOnamesInScope = rule2347 _lhsInamesInScope + _patternOlhsPattern = rule2348 () + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2349 _expressionIcollectScopeInfos _scopeInfo + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2350 _expressionIcollectInstances + _self = rule2351 _expressionIself _patternIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule2352 _self + _lhsOcounter :: Int + _lhsOcounter = rule2353 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2354 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2355 _expressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2356 _expressionIwarnings + _patternOallTypeConstructors = rule2357 _lhsIallTypeConstructors + _patternOallValueConstructors = rule2358 _lhsIallValueConstructors + _patternOcollectScopeInfos = rule2359 _lhsIcollectScopeInfos + _patternOcounter = rule2360 _lhsIcounter + _patternOmiscerrors = rule2361 _lhsImiscerrors + _patternOnamesInScope = rule2362 _namesInScope + _patternOtypeConstructors = rule2363 _lhsItypeConstructors + _patternOvalueConstructors = rule2364 _lhsIvalueConstructors + _patternOwarnings = rule2365 _lhsIwarnings + _expressionOallTypeConstructors = rule2366 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule2367 _lhsIallValueConstructors + _expressionOclassEnvironment = rule2368 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule2369 _patternIcollectScopeInfos + _expressionOcounter = rule2370 _patternIcounter + _expressionOkindErrors = rule2371 _lhsIkindErrors + _expressionOmiscerrors = rule2372 _patternImiscerrors + _expressionOoptions = rule2373 _lhsIoptions + _expressionOorderedTypeSynonyms = rule2374 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule2375 _lhsItypeConstructors + _expressionOvalueConstructors = rule2376 _lhsIvalueConstructors + _expressionOwarnings = rule2377 _patternIwarnings + __result_ = T_Qualifier_vOut127 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule2344 #-} + rule2344 = \ ((_expressionIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsIunboundNames) :: Names) ((_patternIpatVarNames) :: Names) -> + changeOfScope _patternIpatVarNames (_expressionIunboundNames ++ _lhsIunboundNames) _lhsInamesInScope + {-# INLINE rule2345 #-} + rule2345 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2346 #-} + rule2346 = \ _unboundNames -> + _unboundNames + {-# INLINE rule2347 #-} + rule2347 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2348 #-} + rule2348 = \ (_ :: ()) -> + False + {-# INLINE rule2349 #-} + rule2349 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) _scopeInfo -> + (_scopeInfo, Variable) : _expressionIcollectScopeInfos + {-# INLINE rule2350 #-} + rule2350 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule2351 #-} + rule2351 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Qualifier_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule2352 #-} + rule2352 = \ _self -> + _self + {-# INLINE rule2353 #-} + rule2353 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule2354 #-} + rule2354 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule2355 #-} + rule2355 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule2356 #-} + rule2356 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule2357 #-} + rule2357 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2358 #-} + rule2358 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2359 #-} + rule2359 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2360 #-} + rule2360 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2361 #-} + rule2361 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2362 #-} + rule2362 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2363 #-} + rule2363 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2364 #-} + rule2364 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2365 #-} + rule2365 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2366 #-} + rule2366 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2367 #-} + rule2367 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2368 #-} + rule2368 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2369 #-} + rule2369 = \ ((_patternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternIcollectScopeInfos + {-# INLINE rule2370 #-} + rule2370 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule2371 #-} + rule2371 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2372 #-} + rule2372 = \ ((_patternImiscerrors) :: [Error]) -> + _patternImiscerrors + {-# INLINE rule2373 #-} + rule2373 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2374 #-} + rule2374 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2375 #-} + rule2375 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2376 #-} + rule2376 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2377 #-} + rule2377 = \ ((_patternIwarnings) :: [Warning]) -> + _patternIwarnings +{-# NOINLINE sem_Qualifier_Empty #-} +sem_Qualifier_Empty :: T_Range -> T_Qualifier +sem_Qualifier_Empty arg_range_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2378 () + _self = rule2379 _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule2380 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2381 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2382 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2383 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2384 _lhsImiscerrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2385 _lhsInamesInScope + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2386 _lhsIunboundNames + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2387 _lhsIwarnings + __result_ = T_Qualifier_vOut127 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule2378 #-} + rule2378 = \ (_ :: ()) -> + [] + {-# INLINE rule2379 #-} + rule2379 = \ ((_rangeIself) :: Range) -> + Qualifier_Empty _rangeIself + {-# INLINE rule2380 #-} + rule2380 = \ _self -> + _self + {-# INLINE rule2381 #-} + rule2381 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2382 #-} + rule2382 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2383 #-} + rule2383 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2384 #-} + rule2384 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2385 #-} + rule2385 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2386 #-} + rule2386 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule2387 #-} + rule2387 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Qualifiers -------------------------------------------------- +-- wrapper +data Inh_Qualifiers = Inh_Qualifiers { allTypeConstructors_Inh_Qualifiers :: (Names), allValueConstructors_Inh_Qualifiers :: (Names), classEnvironment_Inh_Qualifiers :: (ClassEnvironment), collectScopeInfos_Inh_Qualifiers :: ([(ScopeInfo, Entity)]), counter_Inh_Qualifiers :: (Int), kindErrors_Inh_Qualifiers :: ([Error]), miscerrors_Inh_Qualifiers :: ([Error]), namesInScope_Inh_Qualifiers :: (Names), options_Inh_Qualifiers :: ([Option]), orderedTypeSynonyms_Inh_Qualifiers :: (OrderedTypeSynonyms), typeConstructors_Inh_Qualifiers :: (M.Map Name Int), unboundNames_Inh_Qualifiers :: (Names), valueConstructors_Inh_Qualifiers :: (M.Map Name TpScheme), warnings_Inh_Qualifiers :: ([Warning]) } +data Syn_Qualifiers = Syn_Qualifiers { collectInstances_Syn_Qualifiers :: ([(Name, Instance)]), collectScopeInfos_Syn_Qualifiers :: ([(ScopeInfo, Entity)]), counter_Syn_Qualifiers :: (Int), kindErrors_Syn_Qualifiers :: ([Error]), miscerrors_Syn_Qualifiers :: ([Error]), namesInScope_Syn_Qualifiers :: (Names), self_Syn_Qualifiers :: (Qualifiers), unboundNames_Syn_Qualifiers :: (Names), warnings_Syn_Qualifiers :: ([Warning]) } +{-# INLINABLE wrap_Qualifiers #-} +wrap_Qualifiers :: T_Qualifiers -> Inh_Qualifiers -> (Syn_Qualifiers ) +wrap_Qualifiers (T_Qualifiers act) (Inh_Qualifiers _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifiers_vIn130 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings + (T_Qualifiers_vOut130 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_Qualifiers_s131 sem arg) + return (Syn_Qualifiers _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Qualifiers #-} +sem_Qualifiers :: Qualifiers -> T_Qualifiers +sem_Qualifiers list = Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list) + +-- semantic domain +newtype T_Qualifiers = T_Qualifiers { + attach_T_Qualifiers :: Identity (T_Qualifiers_s131 ) + } +newtype T_Qualifiers_s131 = C_Qualifiers_s131 { + inv_Qualifiers_s131 :: (T_Qualifiers_v130 ) + } +data T_Qualifiers_s132 = C_Qualifiers_s132 +type T_Qualifiers_v130 = (T_Qualifiers_vIn130 ) -> (T_Qualifiers_vOut130 ) +data T_Qualifiers_vIn130 = T_Qualifiers_vIn130 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (Names) (M.Map Name TpScheme) ([Warning]) +data T_Qualifiers_vOut130 = T_Qualifiers_vOut130 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) (Qualifiers) (Names) ([Warning]) +{-# NOINLINE sem_Qualifiers_Cons #-} +sem_Qualifiers_Cons :: T_Qualifier -> T_Qualifiers -> T_Qualifiers +sem_Qualifiers_Cons arg_hd_ arg_tl_ = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _hdX128 = Control.Monad.Identity.runIdentity (attach_T_Qualifier (arg_hd_)) + _tlX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_tl_)) + (T_Qualifier_vOut127 _hdIcollectInstances _hdIcollectScopeInfos _hdIcounter _hdIkindErrors _hdImiscerrors _hdInamesInScope _hdIself _hdIunboundNames _hdIwarnings) = inv_Qualifier_s128 _hdX128 (T_Qualifier_vIn127 _hdOallTypeConstructors _hdOallValueConstructors _hdOclassEnvironment _hdOcollectScopeInfos _hdOcounter _hdOkindErrors _hdOmiscerrors _hdOnamesInScope _hdOoptions _hdOorderedTypeSynonyms _hdOtypeConstructors _hdOunboundNames _hdOvalueConstructors _hdOwarnings) + (T_Qualifiers_vOut130 _tlIcollectInstances _tlIcollectScopeInfos _tlIcounter _tlIkindErrors _tlImiscerrors _tlInamesInScope _tlIself _tlIunboundNames _tlIwarnings) = inv_Qualifiers_s131 _tlX131 (T_Qualifiers_vIn130 _tlOallTypeConstructors _tlOallValueConstructors _tlOclassEnvironment _tlOcollectScopeInfos _tlOcounter _tlOkindErrors _tlOmiscerrors _tlOnamesInScope _tlOoptions _tlOorderedTypeSynonyms _tlOtypeConstructors _tlOunboundNames _tlOvalueConstructors _tlOwarnings) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2388 _hdIunboundNames + _tlOunboundNames = rule2389 _lhsIunboundNames + _hdOunboundNames = rule2390 _tlIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2391 _hdIcollectInstances _tlIcollectInstances + _self = rule2392 _hdIself _tlIself + _lhsOself :: Qualifiers + _lhsOself = rule2393 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2394 _tlIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2395 _tlIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2396 _tlIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2397 _tlImiscerrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2398 _tlInamesInScope + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2399 _tlIwarnings + _hdOallTypeConstructors = rule2400 _lhsIallTypeConstructors + _hdOallValueConstructors = rule2401 _lhsIallValueConstructors + _hdOclassEnvironment = rule2402 _lhsIclassEnvironment + _hdOcollectScopeInfos = rule2403 _lhsIcollectScopeInfos + _hdOcounter = rule2404 _lhsIcounter + _hdOkindErrors = rule2405 _lhsIkindErrors + _hdOmiscerrors = rule2406 _lhsImiscerrors + _hdOnamesInScope = rule2407 _lhsInamesInScope + _hdOoptions = rule2408 _lhsIoptions + _hdOorderedTypeSynonyms = rule2409 _lhsIorderedTypeSynonyms + _hdOtypeConstructors = rule2410 _lhsItypeConstructors + _hdOvalueConstructors = rule2411 _lhsIvalueConstructors + _hdOwarnings = rule2412 _lhsIwarnings + _tlOallTypeConstructors = rule2413 _lhsIallTypeConstructors + _tlOallValueConstructors = rule2414 _lhsIallValueConstructors + _tlOclassEnvironment = rule2415 _lhsIclassEnvironment + _tlOcollectScopeInfos = rule2416 _hdIcollectScopeInfos + _tlOcounter = rule2417 _hdIcounter + _tlOkindErrors = rule2418 _hdIkindErrors + _tlOmiscerrors = rule2419 _hdImiscerrors + _tlOnamesInScope = rule2420 _hdInamesInScope + _tlOoptions = rule2421 _lhsIoptions + _tlOorderedTypeSynonyms = rule2422 _lhsIorderedTypeSynonyms + _tlOtypeConstructors = rule2423 _lhsItypeConstructors + _tlOvalueConstructors = rule2424 _lhsIvalueConstructors + _tlOwarnings = rule2425 _hdIwarnings + __result_ = T_Qualifiers_vOut130 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule2388 #-} + rule2388 = \ ((_hdIunboundNames) :: Names) -> + _hdIunboundNames + {-# INLINE rule2389 #-} + rule2389 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule2390 #-} + rule2390 = \ ((_tlIunboundNames) :: Names) -> + _tlIunboundNames + {-# INLINE rule2391 #-} + rule2391 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule2392 #-} + rule2392 = \ ((_hdIself) :: Qualifier) ((_tlIself) :: Qualifiers) -> + (:) _hdIself _tlIself + {-# INLINE rule2393 #-} + rule2393 = \ _self -> + _self + {-# INLINE rule2394 #-} + rule2394 = \ ((_tlIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _tlIcollectScopeInfos + {-# INLINE rule2395 #-} + rule2395 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule2396 #-} + rule2396 = \ ((_tlIkindErrors) :: [Error]) -> + _tlIkindErrors + {-# INLINE rule2397 #-} + rule2397 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule2398 #-} + rule2398 = \ ((_tlInamesInScope) :: Names) -> + _tlInamesInScope + {-# INLINE rule2399 #-} + rule2399 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule2400 #-} + rule2400 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2401 #-} + rule2401 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2402 #-} + rule2402 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2403 #-} + rule2403 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2404 #-} + rule2404 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2405 #-} + rule2405 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2406 #-} + rule2406 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2407 #-} + rule2407 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2408 #-} + rule2408 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2409 #-} + rule2409 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2410 #-} + rule2410 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2411 #-} + rule2411 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2412 #-} + rule2412 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2413 #-} + rule2413 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2414 #-} + rule2414 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2415 #-} + rule2415 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2416 #-} + rule2416 = \ ((_hdIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _hdIcollectScopeInfos + {-# INLINE rule2417 #-} + rule2417 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule2418 #-} + rule2418 = \ ((_hdIkindErrors) :: [Error]) -> + _hdIkindErrors + {-# INLINE rule2419 #-} + rule2419 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule2420 #-} + rule2420 = \ ((_hdInamesInScope) :: Names) -> + _hdInamesInScope + {-# INLINE rule2421 #-} + rule2421 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2422 #-} + rule2422 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2423 #-} + rule2423 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2424 #-} + rule2424 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2425 #-} + rule2425 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_Qualifiers_Nil #-} +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2426 _lhsIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2427 () + _self = rule2428 () + _lhsOself :: Qualifiers + _lhsOself = rule2429 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2430 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2431 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2432 _lhsIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2433 _lhsImiscerrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2434 _lhsInamesInScope + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2435 _lhsIwarnings + __result_ = T_Qualifiers_vOut130 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule2426 #-} + rule2426 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule2427 #-} + rule2427 = \ (_ :: ()) -> + [] + {-# INLINE rule2428 #-} + rule2428 = \ (_ :: ()) -> + [] + {-# INLINE rule2429 #-} + rule2429 = \ _self -> + _self + {-# INLINE rule2430 #-} + rule2430 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2431 #-} + rule2431 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2432 #-} + rule2432 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2433 #-} + rule2433 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2434 #-} + rule2434 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2435 #-} + rule2435 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Range ------------------------------------------------------- +-- wrapper +data Inh_Range = Inh_Range { } +data Syn_Range = Syn_Range { self_Syn_Range :: (Range) } +{-# INLINABLE wrap_Range #-} +wrap_Range :: T_Range -> Inh_Range -> (Syn_Range ) +wrap_Range (T_Range act) (Inh_Range ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Range_vIn133 + (T_Range_vOut133 _lhsOself) <- return (inv_Range_s134 sem arg) + return (Syn_Range _lhsOself) + ) + +-- cata +{-# INLINE sem_Range #-} +sem_Range :: Range -> T_Range +sem_Range ( Range_Range start_ stop_ ) = sem_Range_Range ( sem_Position start_ ) ( sem_Position stop_ ) + +-- semantic domain +newtype T_Range = T_Range { + attach_T_Range :: Identity (T_Range_s134 ) + } +newtype T_Range_s134 = C_Range_s134 { + inv_Range_s134 :: (T_Range_v133 ) + } +data T_Range_s135 = C_Range_s135 +type T_Range_v133 = (T_Range_vIn133 ) -> (T_Range_vOut133 ) +data T_Range_vIn133 = T_Range_vIn133 +data T_Range_vOut133 = T_Range_vOut133 (Range) +{-# NOINLINE sem_Range_Range #-} +sem_Range_Range :: T_Position -> T_Position -> T_Range +sem_Range_Range arg_start_ arg_stop_ = T_Range (return st134) where + {-# NOINLINE st134 #-} + st134 = let + v133 :: T_Range_v133 + v133 = \ (T_Range_vIn133 ) -> ( let + _startX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_start_)) + _stopX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_stop_)) + (T_Position_vOut124 _startIself) = inv_Position_s125 _startX125 (T_Position_vIn124 ) + (T_Position_vOut124 _stopIself) = inv_Position_s125 _stopX125 (T_Position_vIn124 ) + _self = rule2436 _startIself _stopIself + _lhsOself :: Range + _lhsOself = rule2437 _self + __result_ = T_Range_vOut133 _lhsOself + in __result_ ) + in C_Range_s134 v133 + {-# INLINE rule2436 #-} + rule2436 = \ ((_startIself) :: Position) ((_stopIself) :: Position) -> + Range_Range _startIself _stopIself + {-# INLINE rule2437 #-} + rule2437 = \ _self -> + _self + +-- RecordExpressionBinding ------------------------------------- +-- wrapper +data Inh_RecordExpressionBinding = Inh_RecordExpressionBinding { classEnvironment_Inh_RecordExpressionBinding :: (ClassEnvironment), collectScopeInfos_Inh_RecordExpressionBinding :: ([(ScopeInfo, Entity)]), counter_Inh_RecordExpressionBinding :: (Int), namesInScope_Inh_RecordExpressionBinding :: (Names), options_Inh_RecordExpressionBinding :: ([Option]), orderedTypeSynonyms_Inh_RecordExpressionBinding :: (OrderedTypeSynonyms) } +data Syn_RecordExpressionBinding = Syn_RecordExpressionBinding { collectInstances_Syn_RecordExpressionBinding :: ([(Name, Instance)]), collectScopeInfos_Syn_RecordExpressionBinding :: ([(ScopeInfo, Entity)]), counter_Syn_RecordExpressionBinding :: (Int), self_Syn_RecordExpressionBinding :: (RecordExpressionBinding), unboundNames_Syn_RecordExpressionBinding :: (Names) } +{-# INLINABLE wrap_RecordExpressionBinding #-} +wrap_RecordExpressionBinding :: T_RecordExpressionBinding -> Inh_RecordExpressionBinding -> (Syn_RecordExpressionBinding ) +wrap_RecordExpressionBinding (T_RecordExpressionBinding act) (Inh_RecordExpressionBinding _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBinding_vIn136 _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms + (T_RecordExpressionBinding_vOut136 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames) <- return (inv_RecordExpressionBinding_s137 sem arg) + return (Syn_RecordExpressionBinding _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBinding #-} +sem_RecordExpressionBinding :: RecordExpressionBinding -> T_RecordExpressionBinding +sem_RecordExpressionBinding ( RecordExpressionBinding_RecordExpressionBinding range_ name_ expression_ ) = sem_RecordExpressionBinding_RecordExpressionBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_RecordExpressionBinding = T_RecordExpressionBinding { + attach_T_RecordExpressionBinding :: Identity (T_RecordExpressionBinding_s137 ) + } +newtype T_RecordExpressionBinding_s137 = C_RecordExpressionBinding_s137 { + inv_RecordExpressionBinding_s137 :: (T_RecordExpressionBinding_v136 ) + } +data T_RecordExpressionBinding_s138 = C_RecordExpressionBinding_s138 +type T_RecordExpressionBinding_v136 = (T_RecordExpressionBinding_vIn136 ) -> (T_RecordExpressionBinding_vOut136 ) +data T_RecordExpressionBinding_vIn136 = T_RecordExpressionBinding_vIn136 (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) (Names) ([Option]) (OrderedTypeSynonyms) +data T_RecordExpressionBinding_vOut136 = T_RecordExpressionBinding_vOut136 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) (RecordExpressionBinding) (Names) +{-# NOINLINE sem_RecordExpressionBinding_RecordExpressionBinding #-} +sem_RecordExpressionBinding_RecordExpressionBinding :: T_Range -> T_Name -> T_Expression -> T_RecordExpressionBinding +sem_RecordExpressionBinding_RecordExpressionBinding arg_range_ arg_name_ arg_expression_ = T_RecordExpressionBinding (return st137) where + {-# NOINLINE st137 #-} + st137 = let + v136 :: T_RecordExpressionBinding_v136 + v136 = \ (T_RecordExpressionBinding_vIn136 _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + (_monos,_constructorenv,_betaUnique,_miscerrors,_warnings,_kindErrors,_valueConstructors,_allValueConstructors,_typeConstructors,_allTypeConstructors,_importEnvironment) = rule2438 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2439 _expressionIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2440 _expressionIunboundNames + _self = rule2441 _expressionIself _nameIself _rangeIself + _lhsOself :: RecordExpressionBinding + _lhsOself = rule2442 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2443 _expressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2444 _expressionIcounter + _expressionOallTypeConstructors = rule2445 _allTypeConstructors + _expressionOallValueConstructors = rule2446 _allValueConstructors + _expressionOclassEnvironment = rule2447 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule2448 _lhsIcollectScopeInfos + _expressionOcounter = rule2449 _lhsIcounter + _expressionOkindErrors = rule2450 _kindErrors + _expressionOmiscerrors = rule2451 _miscerrors + _expressionOnamesInScope = rule2452 _lhsInamesInScope + _expressionOoptions = rule2453 _lhsIoptions + _expressionOorderedTypeSynonyms = rule2454 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule2455 _typeConstructors + _expressionOvalueConstructors = rule2456 _valueConstructors + _expressionOwarnings = rule2457 _warnings + __result_ = T_RecordExpressionBinding_vOut136 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_RecordExpressionBinding_s137 v136 + {-# INLINE rule2438 #-} + rule2438 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "RecordExpressionBinding.RecordExpressionBinding" + {-# INLINE rule2439 #-} + rule2439 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule2440 #-} + rule2440 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule2441 #-} + rule2441 = \ ((_expressionIself) :: Expression) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + RecordExpressionBinding_RecordExpressionBinding _rangeIself _nameIself _expressionIself + {-# INLINE rule2442 #-} + rule2442 = \ _self -> + _self + {-# INLINE rule2443 #-} + rule2443 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule2444 #-} + rule2444 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule2445 #-} + rule2445 = \ _allTypeConstructors -> + _allTypeConstructors + {-# INLINE rule2446 #-} + rule2446 = \ _allValueConstructors -> + _allValueConstructors + {-# INLINE rule2447 #-} + rule2447 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2448 #-} + rule2448 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2449 #-} + rule2449 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2450 #-} + rule2450 = \ _kindErrors -> + _kindErrors + {-# INLINE rule2451 #-} + rule2451 = \ _miscerrors -> + _miscerrors + {-# INLINE rule2452 #-} + rule2452 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2453 #-} + rule2453 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2454 #-} + rule2454 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2455 #-} + rule2455 = \ _typeConstructors -> + _typeConstructors + {-# INLINE rule2456 #-} + rule2456 = \ _valueConstructors -> + _valueConstructors + {-# INLINE rule2457 #-} + rule2457 = \ _warnings -> + _warnings + +-- RecordExpressionBindings ------------------------------------ +-- wrapper +data Inh_RecordExpressionBindings = Inh_RecordExpressionBindings { classEnvironment_Inh_RecordExpressionBindings :: (ClassEnvironment), collectScopeInfos_Inh_RecordExpressionBindings :: ([(ScopeInfo, Entity)]), counter_Inh_RecordExpressionBindings :: (Int), namesInScope_Inh_RecordExpressionBindings :: (Names), options_Inh_RecordExpressionBindings :: ([Option]), orderedTypeSynonyms_Inh_RecordExpressionBindings :: (OrderedTypeSynonyms) } +data Syn_RecordExpressionBindings = Syn_RecordExpressionBindings { collectInstances_Syn_RecordExpressionBindings :: ([(Name, Instance)]), collectScopeInfos_Syn_RecordExpressionBindings :: ([(ScopeInfo, Entity)]), counter_Syn_RecordExpressionBindings :: (Int), self_Syn_RecordExpressionBindings :: (RecordExpressionBindings), unboundNames_Syn_RecordExpressionBindings :: (Names) } +{-# INLINABLE wrap_RecordExpressionBindings #-} +wrap_RecordExpressionBindings :: T_RecordExpressionBindings -> Inh_RecordExpressionBindings -> (Syn_RecordExpressionBindings ) +wrap_RecordExpressionBindings (T_RecordExpressionBindings act) (Inh_RecordExpressionBindings _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBindings_vIn139 _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms + (T_RecordExpressionBindings_vOut139 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames) <- return (inv_RecordExpressionBindings_s140 sem arg) + return (Syn_RecordExpressionBindings _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBindings #-} +sem_RecordExpressionBindings :: RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings list = Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list) + +-- semantic domain +newtype T_RecordExpressionBindings = T_RecordExpressionBindings { + attach_T_RecordExpressionBindings :: Identity (T_RecordExpressionBindings_s140 ) + } +newtype T_RecordExpressionBindings_s140 = C_RecordExpressionBindings_s140 { + inv_RecordExpressionBindings_s140 :: (T_RecordExpressionBindings_v139 ) + } +data T_RecordExpressionBindings_s141 = C_RecordExpressionBindings_s141 +type T_RecordExpressionBindings_v139 = (T_RecordExpressionBindings_vIn139 ) -> (T_RecordExpressionBindings_vOut139 ) +data T_RecordExpressionBindings_vIn139 = T_RecordExpressionBindings_vIn139 (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) (Names) ([Option]) (OrderedTypeSynonyms) +data T_RecordExpressionBindings_vOut139 = T_RecordExpressionBindings_vOut139 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) (RecordExpressionBindings) (Names) +{-# NOINLINE sem_RecordExpressionBindings_Cons #-} +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> T_RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons arg_hd_ arg_tl_ = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms) -> ( let + _hdX137 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBinding (arg_hd_)) + _tlX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_tl_)) + (T_RecordExpressionBinding_vOut136 _hdIcollectInstances _hdIcollectScopeInfos _hdIcounter _hdIself _hdIunboundNames) = inv_RecordExpressionBinding_s137 _hdX137 (T_RecordExpressionBinding_vIn136 _hdOclassEnvironment _hdOcollectScopeInfos _hdOcounter _hdOnamesInScope _hdOoptions _hdOorderedTypeSynonyms) + (T_RecordExpressionBindings_vOut139 _tlIcollectInstances _tlIcollectScopeInfos _tlIcounter _tlIself _tlIunboundNames) = inv_RecordExpressionBindings_s140 _tlX140 (T_RecordExpressionBindings_vIn139 _tlOclassEnvironment _tlOcollectScopeInfos _tlOcounter _tlOnamesInScope _tlOoptions _tlOorderedTypeSynonyms) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2458 _hdIcollectInstances _tlIcollectInstances + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2459 _hdIunboundNames _tlIunboundNames + _self = rule2460 _hdIself _tlIself + _lhsOself :: RecordExpressionBindings + _lhsOself = rule2461 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2462 _tlIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2463 _tlIcounter + _hdOclassEnvironment = rule2464 _lhsIclassEnvironment + _hdOcollectScopeInfos = rule2465 _lhsIcollectScopeInfos + _hdOcounter = rule2466 _lhsIcounter + _hdOnamesInScope = rule2467 _lhsInamesInScope + _hdOoptions = rule2468 _lhsIoptions + _hdOorderedTypeSynonyms = rule2469 _lhsIorderedTypeSynonyms + _tlOclassEnvironment = rule2470 _lhsIclassEnvironment + _tlOcollectScopeInfos = rule2471 _hdIcollectScopeInfos + _tlOcounter = rule2472 _hdIcounter + _tlOnamesInScope = rule2473 _lhsInamesInScope + _tlOoptions = rule2474 _lhsIoptions + _tlOorderedTypeSynonyms = rule2475 _lhsIorderedTypeSynonyms + __result_ = T_RecordExpressionBindings_vOut139 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule2458 #-} + rule2458 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule2459 #-} + rule2459 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule2460 #-} + rule2460 = \ ((_hdIself) :: RecordExpressionBinding) ((_tlIself) :: RecordExpressionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule2461 #-} + rule2461 = \ _self -> + _self + {-# INLINE rule2462 #-} + rule2462 = \ ((_tlIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _tlIcollectScopeInfos + {-# INLINE rule2463 #-} + rule2463 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule2464 #-} + rule2464 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2465 #-} + rule2465 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2466 #-} + rule2466 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2467 #-} + rule2467 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2468 #-} + rule2468 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2469 #-} + rule2469 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2470 #-} + rule2470 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2471 #-} + rule2471 = \ ((_hdIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _hdIcollectScopeInfos + {-# INLINE rule2472 #-} + rule2472 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule2473 #-} + rule2473 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2474 #-} + rule2474 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2475 #-} + rule2475 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms +{-# NOINLINE sem_RecordExpressionBindings_Nil #-} +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms) -> ( let + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2476 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2477 () + _self = rule2478 () + _lhsOself :: RecordExpressionBindings + _lhsOself = rule2479 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2480 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2481 _lhsIcounter + __result_ = T_RecordExpressionBindings_vOut139 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule2476 #-} + rule2476 = \ (_ :: ()) -> + [] + {-# INLINE rule2477 #-} + rule2477 = \ (_ :: ()) -> + [] + {-# INLINE rule2478 #-} + rule2478 = \ (_ :: ()) -> + [] + {-# INLINE rule2479 #-} + rule2479 = \ _self -> + _self + {-# INLINE rule2480 #-} + rule2480 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2481 #-} + rule2481 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + +-- RecordPatternBinding ---------------------------------------- +-- wrapper +data Inh_RecordPatternBinding = Inh_RecordPatternBinding { collectScopeInfos_Inh_RecordPatternBinding :: ([(ScopeInfo, Entity)]), counter_Inh_RecordPatternBinding :: (Int), namesInScope_Inh_RecordPatternBinding :: (Names) } +data Syn_RecordPatternBinding = Syn_RecordPatternBinding { collectScopeInfos_Syn_RecordPatternBinding :: ([(ScopeInfo, Entity)]), counter_Syn_RecordPatternBinding :: (Int), self_Syn_RecordPatternBinding :: (RecordPatternBinding), unboundNames_Syn_RecordPatternBinding :: (Names) } +{-# INLINABLE wrap_RecordPatternBinding #-} +wrap_RecordPatternBinding :: T_RecordPatternBinding -> Inh_RecordPatternBinding -> (Syn_RecordPatternBinding ) +wrap_RecordPatternBinding (T_RecordPatternBinding act) (Inh_RecordPatternBinding _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBinding_vIn142 _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope + (T_RecordPatternBinding_vOut142 _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames) <- return (inv_RecordPatternBinding_s143 sem arg) + return (Syn_RecordPatternBinding _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBinding #-} +sem_RecordPatternBinding :: RecordPatternBinding -> T_RecordPatternBinding +sem_RecordPatternBinding ( RecordPatternBinding_RecordPatternBinding range_ name_ pattern_ ) = sem_RecordPatternBinding_RecordPatternBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) + +-- semantic domain +newtype T_RecordPatternBinding = T_RecordPatternBinding { + attach_T_RecordPatternBinding :: Identity (T_RecordPatternBinding_s143 ) + } +newtype T_RecordPatternBinding_s143 = C_RecordPatternBinding_s143 { + inv_RecordPatternBinding_s143 :: (T_RecordPatternBinding_v142 ) + } +data T_RecordPatternBinding_s144 = C_RecordPatternBinding_s144 +type T_RecordPatternBinding_v142 = (T_RecordPatternBinding_vIn142 ) -> (T_RecordPatternBinding_vOut142 ) +data T_RecordPatternBinding_vIn142 = T_RecordPatternBinding_vIn142 ([(ScopeInfo, Entity)]) (Int) (Names) +data T_RecordPatternBinding_vOut142 = T_RecordPatternBinding_vOut142 ([(ScopeInfo, Entity)]) (Int) (RecordPatternBinding) (Names) +{-# NOINLINE sem_RecordPatternBinding_RecordPatternBinding #-} +sem_RecordPatternBinding_RecordPatternBinding :: T_Range -> T_Name -> T_Pattern -> T_RecordPatternBinding +sem_RecordPatternBinding_RecordPatternBinding arg_range_ arg_name_ arg_pattern_ = T_RecordPatternBinding (return st143) where + {-# NOINLINE st143 #-} + st143 = let + v142 :: T_RecordPatternBinding_v142 + v142 = \ (T_RecordPatternBinding_vIn142 _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIcollectScopeInfos _patternIcounter _patternImiscerrors _patternIpatVarNames _patternIself _patternIunboundNames _patternIwarnings) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOallTypeConstructors _patternOallValueConstructors _patternOcollectScopeInfos _patternOcounter _patternOlhsPattern _patternOmiscerrors _patternOnamesInScope _patternOtypeConstructors _patternOvalueConstructors _patternOwarnings) + _patternOlhsPattern = rule2482 () + (_monos,_constructorenv,_betaUnique,_miscerrors,_warnings,_valueConstructors,_allValueConstructors,_typeConstructors,_allTypeConstructors,_importEnvironment) = rule2483 () + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2484 _patternIunboundNames + _self = rule2485 _nameIself _patternIself _rangeIself + _lhsOself :: RecordPatternBinding + _lhsOself = rule2486 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2487 _patternIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2488 _patternIcounter + _patternOallTypeConstructors = rule2489 _allTypeConstructors + _patternOallValueConstructors = rule2490 _allValueConstructors + _patternOcollectScopeInfos = rule2491 _lhsIcollectScopeInfos + _patternOcounter = rule2492 _lhsIcounter + _patternOmiscerrors = rule2493 _miscerrors + _patternOnamesInScope = rule2494 _lhsInamesInScope + _patternOtypeConstructors = rule2495 _typeConstructors + _patternOvalueConstructors = rule2496 _valueConstructors + _patternOwarnings = rule2497 _warnings + __result_ = T_RecordPatternBinding_vOut142 _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_RecordPatternBinding_s143 v142 + {-# INLINE rule2482 #-} + rule2482 = \ (_ :: ()) -> + False + {-# INLINE rule2483 #-} + rule2483 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "RecordPatternBinding.RecordPatternBinding" + {-# INLINE rule2484 #-} + rule2484 = \ ((_patternIunboundNames) :: Names) -> + _patternIunboundNames + {-# INLINE rule2485 #-} + rule2485 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + RecordPatternBinding_RecordPatternBinding _rangeIself _nameIself _patternIself + {-# INLINE rule2486 #-} + rule2486 = \ _self -> + _self + {-# INLINE rule2487 #-} + rule2487 = \ ((_patternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternIcollectScopeInfos + {-# INLINE rule2488 #-} + rule2488 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule2489 #-} + rule2489 = \ _allTypeConstructors -> + _allTypeConstructors + {-# INLINE rule2490 #-} + rule2490 = \ _allValueConstructors -> + _allValueConstructors + {-# INLINE rule2491 #-} + rule2491 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2492 #-} + rule2492 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2493 #-} + rule2493 = \ _miscerrors -> + _miscerrors + {-# INLINE rule2494 #-} + rule2494 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2495 #-} + rule2495 = \ _typeConstructors -> + _typeConstructors + {-# INLINE rule2496 #-} + rule2496 = \ _valueConstructors -> + _valueConstructors + {-# INLINE rule2497 #-} + rule2497 = \ _warnings -> + _warnings + +-- RecordPatternBindings --------------------------------------- +-- wrapper +data Inh_RecordPatternBindings = Inh_RecordPatternBindings { collectScopeInfos_Inh_RecordPatternBindings :: ([(ScopeInfo, Entity)]), counter_Inh_RecordPatternBindings :: (Int), namesInScope_Inh_RecordPatternBindings :: (Names) } +data Syn_RecordPatternBindings = Syn_RecordPatternBindings { collectScopeInfos_Syn_RecordPatternBindings :: ([(ScopeInfo, Entity)]), counter_Syn_RecordPatternBindings :: (Int), self_Syn_RecordPatternBindings :: (RecordPatternBindings), unboundNames_Syn_RecordPatternBindings :: (Names) } +{-# INLINABLE wrap_RecordPatternBindings #-} +wrap_RecordPatternBindings :: T_RecordPatternBindings -> Inh_RecordPatternBindings -> (Syn_RecordPatternBindings ) +wrap_RecordPatternBindings (T_RecordPatternBindings act) (Inh_RecordPatternBindings _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBindings_vIn145 _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope + (T_RecordPatternBindings_vOut145 _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames) <- return (inv_RecordPatternBindings_s146 sem arg) + return (Syn_RecordPatternBindings _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBindings #-} +sem_RecordPatternBindings :: RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings list = Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list) + +-- semantic domain +newtype T_RecordPatternBindings = T_RecordPatternBindings { + attach_T_RecordPatternBindings :: Identity (T_RecordPatternBindings_s146 ) + } +newtype T_RecordPatternBindings_s146 = C_RecordPatternBindings_s146 { + inv_RecordPatternBindings_s146 :: (T_RecordPatternBindings_v145 ) + } +data T_RecordPatternBindings_s147 = C_RecordPatternBindings_s147 +type T_RecordPatternBindings_v145 = (T_RecordPatternBindings_vIn145 ) -> (T_RecordPatternBindings_vOut145 ) +data T_RecordPatternBindings_vIn145 = T_RecordPatternBindings_vIn145 ([(ScopeInfo, Entity)]) (Int) (Names) +data T_RecordPatternBindings_vOut145 = T_RecordPatternBindings_vOut145 ([(ScopeInfo, Entity)]) (Int) (RecordPatternBindings) (Names) +{-# NOINLINE sem_RecordPatternBindings_Cons #-} +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> T_RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings_Cons arg_hd_ arg_tl_ = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope) -> ( let + _hdX143 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBinding (arg_hd_)) + _tlX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_tl_)) + (T_RecordPatternBinding_vOut142 _hdIcollectScopeInfos _hdIcounter _hdIself _hdIunboundNames) = inv_RecordPatternBinding_s143 _hdX143 (T_RecordPatternBinding_vIn142 _hdOcollectScopeInfos _hdOcounter _hdOnamesInScope) + (T_RecordPatternBindings_vOut145 _tlIcollectScopeInfos _tlIcounter _tlIself _tlIunboundNames) = inv_RecordPatternBindings_s146 _tlX146 (T_RecordPatternBindings_vIn145 _tlOcollectScopeInfos _tlOcounter _tlOnamesInScope) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2498 _hdIunboundNames _tlIunboundNames + _self = rule2499 _hdIself _tlIself + _lhsOself :: RecordPatternBindings + _lhsOself = rule2500 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2501 _tlIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2502 _tlIcounter + _hdOcollectScopeInfos = rule2503 _lhsIcollectScopeInfos + _hdOcounter = rule2504 _lhsIcounter + _hdOnamesInScope = rule2505 _lhsInamesInScope + _tlOcollectScopeInfos = rule2506 _hdIcollectScopeInfos + _tlOcounter = rule2507 _hdIcounter + _tlOnamesInScope = rule2508 _lhsInamesInScope + __result_ = T_RecordPatternBindings_vOut145 _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule2498 #-} + rule2498 = \ ((_hdIunboundNames) :: Names) ((_tlIunboundNames) :: Names) -> + _hdIunboundNames ++ _tlIunboundNames + {-# INLINE rule2499 #-} + rule2499 = \ ((_hdIself) :: RecordPatternBinding) ((_tlIself) :: RecordPatternBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule2500 #-} + rule2500 = \ _self -> + _self + {-# INLINE rule2501 #-} + rule2501 = \ ((_tlIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _tlIcollectScopeInfos + {-# INLINE rule2502 #-} + rule2502 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule2503 #-} + rule2503 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2504 #-} + rule2504 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2505 #-} + rule2505 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2506 #-} + rule2506 = \ ((_hdIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _hdIcollectScopeInfos + {-# INLINE rule2507 #-} + rule2507 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule2508 #-} + rule2508 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope +{-# NOINLINE sem_RecordPatternBindings_Nil #-} +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 _lhsIcollectScopeInfos _lhsIcounter _lhsInamesInScope) -> ( let + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2509 () + _self = rule2510 () + _lhsOself :: RecordPatternBindings + _lhsOself = rule2511 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2512 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2513 _lhsIcounter + __result_ = T_RecordPatternBindings_vOut145 _lhsOcollectScopeInfos _lhsOcounter _lhsOself _lhsOunboundNames + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule2509 #-} + rule2509 = \ (_ :: ()) -> + [] + {-# INLINE rule2510 #-} + rule2510 = \ (_ :: ()) -> + [] + {-# INLINE rule2511 #-} + rule2511 = \ _self -> + _self + {-# INLINE rule2512 #-} + rule2512 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2513 #-} + rule2513 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + +-- RightHandSide ----------------------------------------------- +-- wrapper +data Inh_RightHandSide = Inh_RightHandSide { allTypeConstructors_Inh_RightHandSide :: (Names), allValueConstructors_Inh_RightHandSide :: (Names), classEnvironment_Inh_RightHandSide :: (ClassEnvironment), collectScopeInfos_Inh_RightHandSide :: ([(ScopeInfo, Entity)]), counter_Inh_RightHandSide :: (Int), kindErrors_Inh_RightHandSide :: ([Error]), miscerrors_Inh_RightHandSide :: ([Error]), namesInScope_Inh_RightHandSide :: (Names), options_Inh_RightHandSide :: ([Option]), orderedTypeSynonyms_Inh_RightHandSide :: (OrderedTypeSynonyms), typeConstructors_Inh_RightHandSide :: (M.Map Name Int), valueConstructors_Inh_RightHandSide :: (M.Map Name TpScheme), warnings_Inh_RightHandSide :: ([Warning]) } +data Syn_RightHandSide = Syn_RightHandSide { collectInstances_Syn_RightHandSide :: ([(Name, Instance)]), collectScopeInfos_Syn_RightHandSide :: ([(ScopeInfo, Entity)]), counter_Syn_RightHandSide :: (Int), kindErrors_Syn_RightHandSide :: ([Error]), miscerrors_Syn_RightHandSide :: ([Error]), self_Syn_RightHandSide :: (RightHandSide), unboundNames_Syn_RightHandSide :: (Names), warnings_Syn_RightHandSide :: ([Warning]) } +{-# INLINABLE wrap_RightHandSide #-} +wrap_RightHandSide :: T_RightHandSide -> Inh_RightHandSide -> (Syn_RightHandSide ) +wrap_RightHandSide (T_RightHandSide act) (Inh_RightHandSide _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RightHandSide_vIn148 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings + (T_RightHandSide_vOut148 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_RightHandSide_s149 sem arg) + return (Syn_RightHandSide _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_RightHandSide #-} +sem_RightHandSide :: RightHandSide -> T_RightHandSide +sem_RightHandSide ( RightHandSide_Expression range_ expression_ where_ ) = sem_RightHandSide_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_MaybeDeclarations where_ ) +sem_RightHandSide ( RightHandSide_Guarded range_ guardedexpressions_ where_ ) = sem_RightHandSide_Guarded ( sem_Range range_ ) ( sem_GuardedExpressions guardedexpressions_ ) ( sem_MaybeDeclarations where_ ) + +-- semantic domain +newtype T_RightHandSide = T_RightHandSide { + attach_T_RightHandSide :: Identity (T_RightHandSide_s149 ) + } +newtype T_RightHandSide_s149 = C_RightHandSide_s149 { + inv_RightHandSide_s149 :: (T_RightHandSide_v148 ) + } +data T_RightHandSide_s150 = C_RightHandSide_s150 +type T_RightHandSide_v148 = (T_RightHandSide_vIn148 ) -> (T_RightHandSide_vOut148 ) +data T_RightHandSide_vIn148 = T_RightHandSide_vIn148 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (M.Map Name TpScheme) ([Warning]) +data T_RightHandSide_vOut148 = T_RightHandSide_vOut148 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) ([Error]) (RightHandSide) (Names) ([Warning]) +{-# NOINLINE sem_RightHandSide_Expression #-} +sem_RightHandSide_Expression :: T_Range -> T_Expression -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Expression arg_range_ arg_expression_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + (T_MaybeDeclarations_vOut88 _whereIcollectInstances _whereIcollectScopeInfos _whereIcounter _whereIkindErrors _whereImiscerrors _whereInamesInScope _whereIself _whereIunboundNames _whereIwarnings) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOallTypeConstructors _whereOallValueConstructors _whereOclassEnvironment _whereOcollectScopeInfos _whereOcounter _whereOkindErrors _whereOmiscerrors _whereOnamesInScope _whereOoptions _whereOorderedTypeSynonyms _whereOtypeConstructors _whereOunboundNames _whereOvalueConstructors _whereOwarnings) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2514 _whereIunboundNames + _expressionOnamesInScope = rule2515 _whereInamesInScope + _whereOunboundNames = rule2516 _expressionIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2517 _expressionIcollectInstances _whereIcollectInstances + _self = rule2518 _expressionIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule2519 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2520 _whereIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2521 _whereIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2522 _whereIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2523 _whereImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2524 _whereIwarnings + _expressionOallTypeConstructors = rule2525 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule2526 _lhsIallValueConstructors + _expressionOclassEnvironment = rule2527 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule2528 _lhsIcollectScopeInfos + _expressionOcounter = rule2529 _lhsIcounter + _expressionOkindErrors = rule2530 _lhsIkindErrors + _expressionOmiscerrors = rule2531 _lhsImiscerrors + _expressionOoptions = rule2532 _lhsIoptions + _expressionOorderedTypeSynonyms = rule2533 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule2534 _lhsItypeConstructors + _expressionOvalueConstructors = rule2535 _lhsIvalueConstructors + _expressionOwarnings = rule2536 _lhsIwarnings + _whereOallTypeConstructors = rule2537 _lhsIallTypeConstructors + _whereOallValueConstructors = rule2538 _lhsIallValueConstructors + _whereOclassEnvironment = rule2539 _lhsIclassEnvironment + _whereOcollectScopeInfos = rule2540 _expressionIcollectScopeInfos + _whereOcounter = rule2541 _expressionIcounter + _whereOkindErrors = rule2542 _expressionIkindErrors + _whereOmiscerrors = rule2543 _expressionImiscerrors + _whereOnamesInScope = rule2544 _lhsInamesInScope + _whereOoptions = rule2545 _lhsIoptions + _whereOorderedTypeSynonyms = rule2546 _lhsIorderedTypeSynonyms + _whereOtypeConstructors = rule2547 _lhsItypeConstructors + _whereOvalueConstructors = rule2548 _lhsIvalueConstructors + _whereOwarnings = rule2549 _expressionIwarnings + __result_ = T_RightHandSide_vOut148 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule2514 #-} + rule2514 = \ ((_whereIunboundNames) :: Names) -> + _whereIunboundNames + {-# INLINE rule2515 #-} + rule2515 = \ ((_whereInamesInScope) :: Names) -> + _whereInamesInScope + {-# INLINE rule2516 #-} + rule2516 = \ ((_expressionIunboundNames) :: Names) -> + _expressionIunboundNames + {-# INLINE rule2517 #-} + rule2517 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) ((_whereIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances ++ _whereIcollectInstances + {-# INLINE rule2518 #-} + rule2518 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Expression _rangeIself _expressionIself _whereIself + {-# INLINE rule2519 #-} + rule2519 = \ _self -> + _self + {-# INLINE rule2520 #-} + rule2520 = \ ((_whereIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _whereIcollectScopeInfos + {-# INLINE rule2521 #-} + rule2521 = \ ((_whereIcounter) :: Int) -> + _whereIcounter + {-# INLINE rule2522 #-} + rule2522 = \ ((_whereIkindErrors) :: [Error]) -> + _whereIkindErrors + {-# INLINE rule2523 #-} + rule2523 = \ ((_whereImiscerrors) :: [Error]) -> + _whereImiscerrors + {-# INLINE rule2524 #-} + rule2524 = \ ((_whereIwarnings) :: [Warning]) -> + _whereIwarnings + {-# INLINE rule2525 #-} + rule2525 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2526 #-} + rule2526 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2527 #-} + rule2527 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2528 #-} + rule2528 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2529 #-} + rule2529 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2530 #-} + rule2530 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2531 #-} + rule2531 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2532 #-} + rule2532 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2533 #-} + rule2533 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2534 #-} + rule2534 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2535 #-} + rule2535 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2536 #-} + rule2536 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2537 #-} + rule2537 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2538 #-} + rule2538 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2539 #-} + rule2539 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2540 #-} + rule2540 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule2541 #-} + rule2541 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule2542 #-} + rule2542 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule2543 #-} + rule2543 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule2544 #-} + rule2544 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2545 #-} + rule2545 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2546 #-} + rule2546 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2547 #-} + rule2547 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2548 #-} + rule2548 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2549 #-} + rule2549 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings +{-# NOINLINE sem_RightHandSide_Guarded #-} +sem_RightHandSide_Guarded :: T_Range -> T_GuardedExpressions -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Guarded arg_range_ arg_guardedexpressions_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardedexpressionsX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_guardedexpressions_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_GuardedExpressions_vOut64 _guardedexpressionsIcollectInstances _guardedexpressionsIcollectScopeInfos _guardedexpressionsIcounter _guardedexpressionsIkindErrors _guardedexpressionsImiscerrors _guardedexpressionsIself _guardedexpressionsIunboundNames _guardedexpressionsIwarnings) = inv_GuardedExpressions_s65 _guardedexpressionsX65 (T_GuardedExpressions_vIn64 _guardedexpressionsOallTypeConstructors _guardedexpressionsOallValueConstructors _guardedexpressionsOclassEnvironment _guardedexpressionsOcollectScopeInfos _guardedexpressionsOcounter _guardedexpressionsOkindErrors _guardedexpressionsOmiscerrors _guardedexpressionsOnamesInScope _guardedexpressionsOoptions _guardedexpressionsOorderedTypeSynonyms _guardedexpressionsOtypeConstructors _guardedexpressionsOvalueConstructors _guardedexpressionsOwarnings) + (T_MaybeDeclarations_vOut88 _whereIcollectInstances _whereIcollectScopeInfos _whereIcounter _whereIkindErrors _whereImiscerrors _whereInamesInScope _whereIself _whereIunboundNames _whereIwarnings) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 _whereOallTypeConstructors _whereOallValueConstructors _whereOclassEnvironment _whereOcollectScopeInfos _whereOcounter _whereOkindErrors _whereOmiscerrors _whereOnamesInScope _whereOoptions _whereOorderedTypeSynonyms _whereOtypeConstructors _whereOunboundNames _whereOvalueConstructors _whereOwarnings) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2550 _whereIunboundNames + _guardedexpressionsOnamesInScope = rule2551 _whereInamesInScope + _whereOunboundNames = rule2552 _guardedexpressionsIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2553 _guardedexpressionsIcollectInstances _whereIcollectInstances + _self = rule2554 _guardedexpressionsIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule2555 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2556 _whereIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2557 _whereIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2558 _whereIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2559 _whereImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2560 _whereIwarnings + _guardedexpressionsOallTypeConstructors = rule2561 _lhsIallTypeConstructors + _guardedexpressionsOallValueConstructors = rule2562 _lhsIallValueConstructors + _guardedexpressionsOclassEnvironment = rule2563 _lhsIclassEnvironment + _guardedexpressionsOcollectScopeInfos = rule2564 _lhsIcollectScopeInfos + _guardedexpressionsOcounter = rule2565 _lhsIcounter + _guardedexpressionsOkindErrors = rule2566 _lhsIkindErrors + _guardedexpressionsOmiscerrors = rule2567 _lhsImiscerrors + _guardedexpressionsOoptions = rule2568 _lhsIoptions + _guardedexpressionsOorderedTypeSynonyms = rule2569 _lhsIorderedTypeSynonyms + _guardedexpressionsOtypeConstructors = rule2570 _lhsItypeConstructors + _guardedexpressionsOvalueConstructors = rule2571 _lhsIvalueConstructors + _guardedexpressionsOwarnings = rule2572 _lhsIwarnings + _whereOallTypeConstructors = rule2573 _lhsIallTypeConstructors + _whereOallValueConstructors = rule2574 _lhsIallValueConstructors + _whereOclassEnvironment = rule2575 _lhsIclassEnvironment + _whereOcollectScopeInfos = rule2576 _guardedexpressionsIcollectScopeInfos + _whereOcounter = rule2577 _guardedexpressionsIcounter + _whereOkindErrors = rule2578 _guardedexpressionsIkindErrors + _whereOmiscerrors = rule2579 _guardedexpressionsImiscerrors + _whereOnamesInScope = rule2580 _lhsInamesInScope + _whereOoptions = rule2581 _lhsIoptions + _whereOorderedTypeSynonyms = rule2582 _lhsIorderedTypeSynonyms + _whereOtypeConstructors = rule2583 _lhsItypeConstructors + _whereOvalueConstructors = rule2584 _lhsIvalueConstructors + _whereOwarnings = rule2585 _guardedexpressionsIwarnings + __result_ = T_RightHandSide_vOut148 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOmiscerrors _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule2550 #-} + rule2550 = \ ((_whereIunboundNames) :: Names) -> + _whereIunboundNames + {-# INLINE rule2551 #-} + rule2551 = \ ((_whereInamesInScope) :: Names) -> + _whereInamesInScope + {-# INLINE rule2552 #-} + rule2552 = \ ((_guardedexpressionsIunboundNames) :: Names) -> + _guardedexpressionsIunboundNames + {-# INLINE rule2553 #-} + rule2553 = \ ((_guardedexpressionsIcollectInstances) :: [(Name, Instance)]) ((_whereIcollectInstances) :: [(Name, Instance)]) -> + _guardedexpressionsIcollectInstances ++ _whereIcollectInstances + {-# INLINE rule2554 #-} + rule2554 = \ ((_guardedexpressionsIself) :: GuardedExpressions) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Guarded _rangeIself _guardedexpressionsIself _whereIself + {-# INLINE rule2555 #-} + rule2555 = \ _self -> + _self + {-# INLINE rule2556 #-} + rule2556 = \ ((_whereIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _whereIcollectScopeInfos + {-# INLINE rule2557 #-} + rule2557 = \ ((_whereIcounter) :: Int) -> + _whereIcounter + {-# INLINE rule2558 #-} + rule2558 = \ ((_whereIkindErrors) :: [Error]) -> + _whereIkindErrors + {-# INLINE rule2559 #-} + rule2559 = \ ((_whereImiscerrors) :: [Error]) -> + _whereImiscerrors + {-# INLINE rule2560 #-} + rule2560 = \ ((_whereIwarnings) :: [Warning]) -> + _whereIwarnings + {-# INLINE rule2561 #-} + rule2561 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2562 #-} + rule2562 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2563 #-} + rule2563 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2564 #-} + rule2564 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2565 #-} + rule2565 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2566 #-} + rule2566 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2567 #-} + rule2567 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2568 #-} + rule2568 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2569 #-} + rule2569 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2570 #-} + rule2570 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2571 #-} + rule2571 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2572 #-} + rule2572 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2573 #-} + rule2573 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2574 #-} + rule2574 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2575 #-} + rule2575 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2576 #-} + rule2576 = \ ((_guardedexpressionsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _guardedexpressionsIcollectScopeInfos + {-# INLINE rule2577 #-} + rule2577 = \ ((_guardedexpressionsIcounter) :: Int) -> + _guardedexpressionsIcounter + {-# INLINE rule2578 #-} + rule2578 = \ ((_guardedexpressionsIkindErrors) :: [Error]) -> + _guardedexpressionsIkindErrors + {-# INLINE rule2579 #-} + rule2579 = \ ((_guardedexpressionsImiscerrors) :: [Error]) -> + _guardedexpressionsImiscerrors + {-# INLINE rule2580 #-} + rule2580 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2581 #-} + rule2581 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2582 #-} + rule2582 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2583 #-} + rule2583 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2584 #-} + rule2584 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2585 #-} + rule2585 = \ ((_guardedexpressionsIwarnings) :: [Warning]) -> + _guardedexpressionsIwarnings + +-- SimpleType -------------------------------------------------- +-- wrapper +data Inh_SimpleType = Inh_SimpleType { } +data Syn_SimpleType = Syn_SimpleType { name_Syn_SimpleType :: (Name), self_Syn_SimpleType :: (SimpleType), typevariables_Syn_SimpleType :: (Names) } +{-# INLINABLE wrap_SimpleType #-} +wrap_SimpleType :: T_SimpleType -> Inh_SimpleType -> (Syn_SimpleType ) +wrap_SimpleType (T_SimpleType act) (Inh_SimpleType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_SimpleType_vIn151 + (T_SimpleType_vOut151 _lhsOname _lhsOself _lhsOtypevariables) <- return (inv_SimpleType_s152 sem arg) + return (Syn_SimpleType _lhsOname _lhsOself _lhsOtypevariables) + ) + +-- cata +{-# INLINE sem_SimpleType #-} +sem_SimpleType :: SimpleType -> T_SimpleType +sem_SimpleType ( SimpleType_SimpleType range_ name_ typevariables_ ) = sem_SimpleType_SimpleType ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Names typevariables_ ) + +-- semantic domain +newtype T_SimpleType = T_SimpleType { + attach_T_SimpleType :: Identity (T_SimpleType_s152 ) + } +newtype T_SimpleType_s152 = C_SimpleType_s152 { + inv_SimpleType_s152 :: (T_SimpleType_v151 ) + } +data T_SimpleType_s153 = C_SimpleType_s153 +type T_SimpleType_v151 = (T_SimpleType_vIn151 ) -> (T_SimpleType_vOut151 ) +data T_SimpleType_vIn151 = T_SimpleType_vIn151 +data T_SimpleType_vOut151 = T_SimpleType_vOut151 (Name) (SimpleType) (Names) +{-# NOINLINE sem_SimpleType_SimpleType #-} +sem_SimpleType_SimpleType :: T_Range -> T_Name -> T_Names -> T_SimpleType +sem_SimpleType_SimpleType arg_range_ arg_name_ arg_typevariables_ = T_SimpleType (return st152) where + {-# NOINLINE st152 #-} + st152 = let + v151 :: T_SimpleType_v151 + v151 = \ (T_SimpleType_vIn151 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + _lhsOname :: Name + _lhsOname = rule2586 _nameIself + _lhsOtypevariables :: Names + _lhsOtypevariables = rule2587 _typevariablesIself + _self = rule2588 _nameIself _rangeIself _typevariablesIself + _lhsOself :: SimpleType + _lhsOself = rule2589 _self + __result_ = T_SimpleType_vOut151 _lhsOname _lhsOself _lhsOtypevariables + in __result_ ) + in C_SimpleType_s152 v151 + {-# INLINE rule2586 #-} + rule2586 = \ ((_nameIself) :: Name) -> + _nameIself + {-# INLINE rule2587 #-} + rule2587 = \ ((_typevariablesIself) :: Names) -> + _typevariablesIself + {-# INLINE rule2588 #-} + rule2588 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typevariablesIself) :: Names) -> + SimpleType_SimpleType _rangeIself _nameIself _typevariablesIself + {-# INLINE rule2589 #-} + rule2589 = \ _self -> + _self + +-- Statement --------------------------------------------------- +-- wrapper +data Inh_Statement = Inh_Statement { allTypeConstructors_Inh_Statement :: (Names), allValueConstructors_Inh_Statement :: (Names), classEnvironment_Inh_Statement :: (ClassEnvironment), collectScopeInfos_Inh_Statement :: ([(ScopeInfo, Entity)]), counter_Inh_Statement :: (Int), kindErrors_Inh_Statement :: ([Error]), lastStatementIsExpr_Inh_Statement :: (Bool), miscerrors_Inh_Statement :: ([Error]), namesInScope_Inh_Statement :: (Names), options_Inh_Statement :: ([Option]), orderedTypeSynonyms_Inh_Statement :: (OrderedTypeSynonyms), typeConstructors_Inh_Statement :: (M.Map Name Int), unboundNames_Inh_Statement :: (Names), valueConstructors_Inh_Statement :: (M.Map Name TpScheme), warnings_Inh_Statement :: ([Warning]) } +data Syn_Statement = Syn_Statement { collectInstances_Syn_Statement :: ([(Name, Instance)]), collectScopeInfos_Syn_Statement :: ([(ScopeInfo, Entity)]), counter_Syn_Statement :: (Int), kindErrors_Syn_Statement :: ([Error]), lastStatementIsExpr_Syn_Statement :: (Bool), miscerrors_Syn_Statement :: ([Error]), namesInScope_Syn_Statement :: (Names), self_Syn_Statement :: (Statement), unboundNames_Syn_Statement :: (Names), warnings_Syn_Statement :: ([Warning]) } +{-# INLINABLE wrap_Statement #-} +wrap_Statement :: T_Statement -> Inh_Statement -> (Syn_Statement ) +wrap_Statement (T_Statement act) (Inh_Statement _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsIlastStatementIsExpr _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statement_vIn154 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsIlastStatementIsExpr _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings + (T_Statement_vOut154 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOlastStatementIsExpr _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_Statement_s155 sem arg) + return (Syn_Statement _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOlastStatementIsExpr _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Statement #-} +sem_Statement :: Statement -> T_Statement +sem_Statement ( Statement_Expression range_ expression_ ) = sem_Statement_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Let range_ declarations_ ) = sem_Statement_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Statement ( Statement_Generator range_ pattern_ expression_ ) = sem_Statement_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Empty range_ ) = sem_Statement_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Statement = T_Statement { + attach_T_Statement :: Identity (T_Statement_s155 ) + } +newtype T_Statement_s155 = C_Statement_s155 { + inv_Statement_s155 :: (T_Statement_v154 ) + } +data T_Statement_s156 = C_Statement_s156 +type T_Statement_v154 = (T_Statement_vIn154 ) -> (T_Statement_vOut154 ) +data T_Statement_vIn154 = T_Statement_vIn154 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) (Bool) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (Names) (M.Map Name TpScheme) ([Warning]) +data T_Statement_vOut154 = T_Statement_vOut154 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) (Bool) ([Error]) (Names) (Statement) (Names) ([Warning]) +{-# NOINLINE sem_Statement_Expression #-} +sem_Statement_Expression :: T_Range -> T_Expression -> T_Statement +sem_Statement_Expression arg_range_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsIlastStatementIsExpr _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2590 _expressionIunboundNames _lhsIunboundNames + _lhsOlastStatementIsExpr :: Bool + _lhsOlastStatementIsExpr = rule2591 () + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2592 _expressionIcollectInstances + _self = rule2593 _expressionIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule2594 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2595 _expressionIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2596 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2597 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2598 _expressionImiscerrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2599 _lhsInamesInScope + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2600 _expressionIwarnings + _expressionOallTypeConstructors = rule2601 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule2602 _lhsIallValueConstructors + _expressionOclassEnvironment = rule2603 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule2604 _lhsIcollectScopeInfos + _expressionOcounter = rule2605 _lhsIcounter + _expressionOkindErrors = rule2606 _lhsIkindErrors + _expressionOmiscerrors = rule2607 _lhsImiscerrors + _expressionOnamesInScope = rule2608 _lhsInamesInScope + _expressionOoptions = rule2609 _lhsIoptions + _expressionOorderedTypeSynonyms = rule2610 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule2611 _lhsItypeConstructors + _expressionOvalueConstructors = rule2612 _lhsIvalueConstructors + _expressionOwarnings = rule2613 _lhsIwarnings + __result_ = T_Statement_vOut154 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOlastStatementIsExpr _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule2590 #-} + rule2590 = \ ((_expressionIunboundNames) :: Names) ((_lhsIunboundNames) :: Names) -> + _expressionIunboundNames ++ _lhsIunboundNames + {-# INLINE rule2591 #-} + rule2591 = \ (_ :: ()) -> + True + {-# INLINE rule2592 #-} + rule2592 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule2593 #-} + rule2593 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Statement_Expression _rangeIself _expressionIself + {-# INLINE rule2594 #-} + rule2594 = \ _self -> + _self + {-# INLINE rule2595 #-} + rule2595 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _expressionIcollectScopeInfos + {-# INLINE rule2596 #-} + rule2596 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule2597 #-} + rule2597 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule2598 #-} + rule2598 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule2599 #-} + rule2599 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2600 #-} + rule2600 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule2601 #-} + rule2601 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2602 #-} + rule2602 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2603 #-} + rule2603 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2604 #-} + rule2604 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2605 #-} + rule2605 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2606 #-} + rule2606 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2607 #-} + rule2607 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2608 #-} + rule2608 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2609 #-} + rule2609 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2610 #-} + rule2610 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2611 #-} + rule2611 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2612 #-} + rule2612 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2613 #-} + rule2613 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Statement_Let #-} +sem_Statement_Let :: T_Range -> T_Declarations -> T_Statement +sem_Statement_Let arg_range_ arg_declarations_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsIlastStatementIsExpr _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIcollectInstances _declarationsIcollectScopeInfos _declarationsIcollectTypeConstructors _declarationsIcollectTypeSynonyms _declarationsIcollectValueConstructors _declarationsIcounter _declarationsIdeclVarNames _declarationsIkindErrors _declarationsImiscerrors _declarationsIoperatorFixities _declarationsIpreviousWasAlsoFB _declarationsIrestrictedNames _declarationsIself _declarationsIsuspiciousFBs _declarationsItypeSignatures _declarationsIunboundNames _declarationsIwarnings) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 _declarationsOallTypeConstructors _declarationsOallValueConstructors _declarationsOclassEnvironment _declarationsOcollectScopeInfos _declarationsOcollectTypeConstructors _declarationsOcollectTypeSynonyms _declarationsOcollectValueConstructors _declarationsOcounter _declarationsOkindErrors _declarationsOmiscerrors _declarationsOnamesInScope _declarationsOoperatorFixities _declarationsOoptions _declarationsOorderedTypeSynonyms _declarationsOpreviousWasAlsoFB _declarationsOsuspiciousFBs _declarationsOtypeConstructors _declarationsOtypeSignatures _declarationsOvalueConstructors _declarationsOwarnings) + _declarationsOtypeSignatures = rule2614 () + (_namesInScope,_unboundNames,_scopeInfo) = rule2615 _declarationsIdeclVarNames _declarationsIunboundNames _lhsInamesInScope _lhsIunboundNames + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2616 _unboundNames + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2617 _declarationsIwarnings _suspiciousErrors + _declarationsOpreviousWasAlsoFB = rule2618 () + _declarationsOsuspiciousFBs = rule2619 () + _suspiciousErrors = rule2620 _declarationsIsuspiciousFBs _declarationsItypeSignatures + _lhsOlastStatementIsExpr :: Bool + _lhsOlastStatementIsExpr = rule2621 () + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2622 _declarationsImiscerrors _typeSignatureErrors + (_,_doubles) = rule2623 _declarationsItypeSignatures + _typeSignatureErrors = rule2624 _declarationsIdeclVarNames _declarationsIrestrictedNames _declarationsItypeSignatures + (_collectTypeConstructors,_collectValueConstructors,_collectTypeSynonyms,_collectConstructorEnv,_derivedFunctions,_operatorFixities) = rule2625 () + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2626 _declarationsIcollectScopeInfos _scopeInfo + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2627 _declarationsIcollectInstances + _self = rule2628 _declarationsIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule2629 _self + _lhsOcounter :: Int + _lhsOcounter = rule2630 _declarationsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2631 _declarationsIkindErrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2632 _namesInScope + _declarationsOallTypeConstructors = rule2633 _lhsIallTypeConstructors + _declarationsOallValueConstructors = rule2634 _lhsIallValueConstructors + _declarationsOclassEnvironment = rule2635 _lhsIclassEnvironment + _declarationsOcollectScopeInfos = rule2636 _lhsIcollectScopeInfos + _declarationsOcollectTypeConstructors = rule2637 _collectTypeConstructors + _declarationsOcollectTypeSynonyms = rule2638 _collectTypeSynonyms + _declarationsOcollectValueConstructors = rule2639 _collectValueConstructors + _declarationsOcounter = rule2640 _lhsIcounter + _declarationsOkindErrors = rule2641 _lhsIkindErrors + _declarationsOmiscerrors = rule2642 _lhsImiscerrors + _declarationsOnamesInScope = rule2643 _namesInScope + _declarationsOoperatorFixities = rule2644 _operatorFixities + _declarationsOoptions = rule2645 _lhsIoptions + _declarationsOorderedTypeSynonyms = rule2646 _lhsIorderedTypeSynonyms + _declarationsOtypeConstructors = rule2647 _lhsItypeConstructors + _declarationsOvalueConstructors = rule2648 _lhsIvalueConstructors + _declarationsOwarnings = rule2649 _lhsIwarnings + __result_ = T_Statement_vOut154 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOlastStatementIsExpr _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule2614 #-} + rule2614 = \ (_ :: ()) -> + [] + {-# INLINE rule2615 #-} + rule2615 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsIunboundNames) :: Names) -> + changeOfScope _declarationsIdeclVarNames (_declarationsIunboundNames ++ _lhsIunboundNames) _lhsInamesInScope + {-# INLINE rule2616 #-} + rule2616 = \ _unboundNames -> + _unboundNames + {-# INLINE rule2617 #-} + rule2617 = \ ((_declarationsIwarnings) :: [Warning]) _suspiciousErrors -> + _declarationsIwarnings ++ + _suspiciousErrors + {-# INLINE rule2618 #-} + rule2618 = \ (_ :: ()) -> + Nothing + {-# INLINE rule2619 #-} + rule2619 = \ (_ :: ()) -> + [] + {-# INLINE rule2620 #-} + rule2620 = \ ((_declarationsIsuspiciousFBs) :: [(Name,Name)]) ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + findSimilarFunctionBindings _declarationsItypeSignatures _declarationsIsuspiciousFBs + {-# INLINE rule2621 #-} + rule2621 = \ (_ :: ()) -> + False + {-# INLINE rule2622 #-} + rule2622 = \ ((_declarationsImiscerrors) :: [Error]) _typeSignatureErrors -> + _typeSignatureErrors ++ _declarationsImiscerrors + {-# INLINE rule2623 #-} + rule2623 = \ ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + uniqueAppearance (map fst _declarationsItypeSignatures) + {-# INLINE rule2624 #-} + rule2624 = \ ((_declarationsIdeclVarNames) :: Names) ((_declarationsIrestrictedNames) :: Names) ((_declarationsItypeSignatures) :: [(Name,TpScheme)]) -> + checkTypeSignatures _declarationsIdeclVarNames _declarationsIrestrictedNames _declarationsItypeSignatures + {-# INLINE rule2625 #-} + rule2625 = \ (_ :: ()) -> + internalError "PartialSyntax.ag" "n/a" "toplevel Statement" + {-# INLINE rule2626 #-} + rule2626 = \ ((_declarationsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) _scopeInfo -> + (_scopeInfo, Definition) : _declarationsIcollectScopeInfos + {-# INLINE rule2627 #-} + rule2627 = \ ((_declarationsIcollectInstances) :: [(Name, Instance)]) -> + _declarationsIcollectInstances + {-# INLINE rule2628 #-} + rule2628 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Statement_Let _rangeIself _declarationsIself + {-# INLINE rule2629 #-} + rule2629 = \ _self -> + _self + {-# INLINE rule2630 #-} + rule2630 = \ ((_declarationsIcounter) :: Int) -> + _declarationsIcounter + {-# INLINE rule2631 #-} + rule2631 = \ ((_declarationsIkindErrors) :: [Error]) -> + _declarationsIkindErrors + {-# INLINE rule2632 #-} + rule2632 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2633 #-} + rule2633 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2634 #-} + rule2634 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2635 #-} + rule2635 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2636 #-} + rule2636 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2637 #-} + rule2637 = \ _collectTypeConstructors -> + _collectTypeConstructors + {-# INLINE rule2638 #-} + rule2638 = \ _collectTypeSynonyms -> + _collectTypeSynonyms + {-# INLINE rule2639 #-} + rule2639 = \ _collectValueConstructors -> + _collectValueConstructors + {-# INLINE rule2640 #-} + rule2640 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2641 #-} + rule2641 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2642 #-} + rule2642 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2643 #-} + rule2643 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2644 #-} + rule2644 = \ _operatorFixities -> + _operatorFixities + {-# INLINE rule2645 #-} + rule2645 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2646 #-} + rule2646 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2647 #-} + rule2647 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2648 #-} + rule2648 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2649 #-} + rule2649 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Statement_Generator #-} +sem_Statement_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Statement +sem_Statement_Generator arg_range_ arg_pattern_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsIlastStatementIsExpr _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIcollectScopeInfos _patternIcounter _patternImiscerrors _patternIpatVarNames _patternIself _patternIunboundNames _patternIwarnings) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 _patternOallTypeConstructors _patternOallValueConstructors _patternOcollectScopeInfos _patternOcounter _patternOlhsPattern _patternOmiscerrors _patternOnamesInScope _patternOtypeConstructors _patternOvalueConstructors _patternOwarnings) + (T_Expression_vOut40 _expressionIcollectInstances _expressionIcollectScopeInfos _expressionIcounter _expressionIkindErrors _expressionImiscerrors _expressionIself _expressionIunboundNames _expressionIwarnings) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 _expressionOallTypeConstructors _expressionOallValueConstructors _expressionOclassEnvironment _expressionOcollectScopeInfos _expressionOcounter _expressionOkindErrors _expressionOmiscerrors _expressionOnamesInScope _expressionOoptions _expressionOorderedTypeSynonyms _expressionOtypeConstructors _expressionOvalueConstructors _expressionOwarnings) + (_namesInScope,_unboundNames,_scopeInfo) = rule2650 _expressionIunboundNames _lhsInamesInScope _lhsIunboundNames _patternIpatVarNames + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2651 _namesInScope + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2652 _unboundNames + _expressionOnamesInScope = rule2653 _lhsInamesInScope + _lhsOlastStatementIsExpr :: Bool + _lhsOlastStatementIsExpr = rule2654 () + _patternOlhsPattern = rule2655 () + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2656 _expressionIcollectScopeInfos _scopeInfo + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2657 _expressionIcollectInstances + _self = rule2658 _expressionIself _patternIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule2659 _self + _lhsOcounter :: Int + _lhsOcounter = rule2660 _expressionIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2661 _expressionIkindErrors + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2662 _expressionImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2663 _expressionIwarnings + _patternOallTypeConstructors = rule2664 _lhsIallTypeConstructors + _patternOallValueConstructors = rule2665 _lhsIallValueConstructors + _patternOcollectScopeInfos = rule2666 _lhsIcollectScopeInfos + _patternOcounter = rule2667 _lhsIcounter + _patternOmiscerrors = rule2668 _lhsImiscerrors + _patternOnamesInScope = rule2669 _namesInScope + _patternOtypeConstructors = rule2670 _lhsItypeConstructors + _patternOvalueConstructors = rule2671 _lhsIvalueConstructors + _patternOwarnings = rule2672 _lhsIwarnings + _expressionOallTypeConstructors = rule2673 _lhsIallTypeConstructors + _expressionOallValueConstructors = rule2674 _lhsIallValueConstructors + _expressionOclassEnvironment = rule2675 _lhsIclassEnvironment + _expressionOcollectScopeInfos = rule2676 _patternIcollectScopeInfos + _expressionOcounter = rule2677 _patternIcounter + _expressionOkindErrors = rule2678 _lhsIkindErrors + _expressionOmiscerrors = rule2679 _patternImiscerrors + _expressionOoptions = rule2680 _lhsIoptions + _expressionOorderedTypeSynonyms = rule2681 _lhsIorderedTypeSynonyms + _expressionOtypeConstructors = rule2682 _lhsItypeConstructors + _expressionOvalueConstructors = rule2683 _lhsIvalueConstructors + _expressionOwarnings = rule2684 _patternIwarnings + __result_ = T_Statement_vOut154 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOlastStatementIsExpr _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule2650 #-} + rule2650 = \ ((_expressionIunboundNames) :: Names) ((_lhsInamesInScope) :: Names) ((_lhsIunboundNames) :: Names) ((_patternIpatVarNames) :: Names) -> + changeOfScope _patternIpatVarNames (_expressionIunboundNames ++ _lhsIunboundNames) _lhsInamesInScope + {-# INLINE rule2651 #-} + rule2651 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2652 #-} + rule2652 = \ _unboundNames -> + _unboundNames + {-# INLINE rule2653 #-} + rule2653 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2654 #-} + rule2654 = \ (_ :: ()) -> + False + {-# INLINE rule2655 #-} + rule2655 = \ (_ :: ()) -> + False + {-# INLINE rule2656 #-} + rule2656 = \ ((_expressionIcollectScopeInfos) :: [(ScopeInfo, Entity)]) _scopeInfo -> + (_scopeInfo, Variable) : _expressionIcollectScopeInfos + {-# INLINE rule2657 #-} + rule2657 = \ ((_expressionIcollectInstances) :: [(Name, Instance)]) -> + _expressionIcollectInstances + {-# INLINE rule2658 #-} + rule2658 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Statement_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule2659 #-} + rule2659 = \ _self -> + _self + {-# INLINE rule2660 #-} + rule2660 = \ ((_expressionIcounter) :: Int) -> + _expressionIcounter + {-# INLINE rule2661 #-} + rule2661 = \ ((_expressionIkindErrors) :: [Error]) -> + _expressionIkindErrors + {-# INLINE rule2662 #-} + rule2662 = \ ((_expressionImiscerrors) :: [Error]) -> + _expressionImiscerrors + {-# INLINE rule2663 #-} + rule2663 = \ ((_expressionIwarnings) :: [Warning]) -> + _expressionIwarnings + {-# INLINE rule2664 #-} + rule2664 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2665 #-} + rule2665 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2666 #-} + rule2666 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2667 #-} + rule2667 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2668 #-} + rule2668 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2669 #-} + rule2669 = \ _namesInScope -> + _namesInScope + {-# INLINE rule2670 #-} + rule2670 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2671 #-} + rule2671 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2672 #-} + rule2672 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2673 #-} + rule2673 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2674 #-} + rule2674 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2675 #-} + rule2675 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2676 #-} + rule2676 = \ ((_patternIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _patternIcollectScopeInfos + {-# INLINE rule2677 #-} + rule2677 = \ ((_patternIcounter) :: Int) -> + _patternIcounter + {-# INLINE rule2678 #-} + rule2678 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2679 #-} + rule2679 = \ ((_patternImiscerrors) :: [Error]) -> + _patternImiscerrors + {-# INLINE rule2680 #-} + rule2680 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2681 #-} + rule2681 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2682 #-} + rule2682 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2683 #-} + rule2683 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2684 #-} + rule2684 = \ ((_patternIwarnings) :: [Warning]) -> + _patternIwarnings +{-# NOINLINE sem_Statement_Empty #-} +sem_Statement_Empty :: T_Range -> T_Statement +sem_Statement_Empty arg_range_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsIlastStatementIsExpr _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2685 () + _self = rule2686 _rangeIself + _lhsOself :: Statement + _lhsOself = rule2687 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2688 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2689 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2690 _lhsIkindErrors + _lhsOlastStatementIsExpr :: Bool + _lhsOlastStatementIsExpr = rule2691 _lhsIlastStatementIsExpr + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2692 _lhsImiscerrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2693 _lhsInamesInScope + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2694 _lhsIunboundNames + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2695 _lhsIwarnings + __result_ = T_Statement_vOut154 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOlastStatementIsExpr _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule2685 #-} + rule2685 = \ (_ :: ()) -> + [] + {-# INLINE rule2686 #-} + rule2686 = \ ((_rangeIself) :: Range) -> + Statement_Empty _rangeIself + {-# INLINE rule2687 #-} + rule2687 = \ _self -> + _self + {-# INLINE rule2688 #-} + rule2688 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2689 #-} + rule2689 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2690 #-} + rule2690 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2691 #-} + rule2691 = \ ((_lhsIlastStatementIsExpr) :: Bool) -> + _lhsIlastStatementIsExpr + {-# INLINE rule2692 #-} + rule2692 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2693 #-} + rule2693 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2694 #-} + rule2694 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule2695 #-} + rule2695 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Statements -------------------------------------------------- +-- wrapper +data Inh_Statements = Inh_Statements { allTypeConstructors_Inh_Statements :: (Names), allValueConstructors_Inh_Statements :: (Names), classEnvironment_Inh_Statements :: (ClassEnvironment), collectScopeInfos_Inh_Statements :: ([(ScopeInfo, Entity)]), counter_Inh_Statements :: (Int), kindErrors_Inh_Statements :: ([Error]), lastStatementIsExpr_Inh_Statements :: (Bool), miscerrors_Inh_Statements :: ([Error]), namesInScope_Inh_Statements :: (Names), options_Inh_Statements :: ([Option]), orderedTypeSynonyms_Inh_Statements :: (OrderedTypeSynonyms), typeConstructors_Inh_Statements :: (M.Map Name Int), unboundNames_Inh_Statements :: (Names), valueConstructors_Inh_Statements :: (M.Map Name TpScheme), warnings_Inh_Statements :: ([Warning]) } +data Syn_Statements = Syn_Statements { collectInstances_Syn_Statements :: ([(Name, Instance)]), collectScopeInfos_Syn_Statements :: ([(ScopeInfo, Entity)]), counter_Syn_Statements :: (Int), kindErrors_Syn_Statements :: ([Error]), lastStatementIsExpr_Syn_Statements :: (Bool), miscerrors_Syn_Statements :: ([Error]), namesInScope_Syn_Statements :: (Names), self_Syn_Statements :: (Statements), unboundNames_Syn_Statements :: (Names), warnings_Syn_Statements :: ([Warning]) } +{-# INLINABLE wrap_Statements #-} +wrap_Statements :: T_Statements -> Inh_Statements -> (Syn_Statements ) +wrap_Statements (T_Statements act) (Inh_Statements _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsIlastStatementIsExpr _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statements_vIn157 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsIlastStatementIsExpr _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings + (T_Statements_vOut157 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOlastStatementIsExpr _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings) <- return (inv_Statements_s158 sem arg) + return (Syn_Statements _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOlastStatementIsExpr _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Statements #-} +sem_Statements :: Statements -> T_Statements +sem_Statements list = Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list) + +-- semantic domain +newtype T_Statements = T_Statements { + attach_T_Statements :: Identity (T_Statements_s158 ) + } +newtype T_Statements_s158 = C_Statements_s158 { + inv_Statements_s158 :: (T_Statements_v157 ) + } +data T_Statements_s159 = C_Statements_s159 +type T_Statements_v157 = (T_Statements_vIn157 ) -> (T_Statements_vOut157 ) +data T_Statements_vIn157 = T_Statements_vIn157 (Names) (Names) (ClassEnvironment) ([(ScopeInfo, Entity)]) (Int) ([Error]) (Bool) ([Error]) (Names) ([Option]) (OrderedTypeSynonyms) (M.Map Name Int) (Names) (M.Map Name TpScheme) ([Warning]) +data T_Statements_vOut157 = T_Statements_vOut157 ([(Name, Instance)]) ([(ScopeInfo, Entity)]) (Int) ([Error]) (Bool) ([Error]) (Names) (Statements) (Names) ([Warning]) +{-# NOINLINE sem_Statements_Cons #-} +sem_Statements_Cons :: T_Statement -> T_Statements -> T_Statements +sem_Statements_Cons arg_hd_ arg_tl_ = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsIlastStatementIsExpr _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _hdX155 = Control.Monad.Identity.runIdentity (attach_T_Statement (arg_hd_)) + _tlX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_tl_)) + (T_Statement_vOut154 _hdIcollectInstances _hdIcollectScopeInfos _hdIcounter _hdIkindErrors _hdIlastStatementIsExpr _hdImiscerrors _hdInamesInScope _hdIself _hdIunboundNames _hdIwarnings) = inv_Statement_s155 _hdX155 (T_Statement_vIn154 _hdOallTypeConstructors _hdOallValueConstructors _hdOclassEnvironment _hdOcollectScopeInfos _hdOcounter _hdOkindErrors _hdOlastStatementIsExpr _hdOmiscerrors _hdOnamesInScope _hdOoptions _hdOorderedTypeSynonyms _hdOtypeConstructors _hdOunboundNames _hdOvalueConstructors _hdOwarnings) + (T_Statements_vOut157 _tlIcollectInstances _tlIcollectScopeInfos _tlIcounter _tlIkindErrors _tlIlastStatementIsExpr _tlImiscerrors _tlInamesInScope _tlIself _tlIunboundNames _tlIwarnings) = inv_Statements_s158 _tlX158 (T_Statements_vIn157 _tlOallTypeConstructors _tlOallValueConstructors _tlOclassEnvironment _tlOcollectScopeInfos _tlOcounter _tlOkindErrors _tlOlastStatementIsExpr _tlOmiscerrors _tlOnamesInScope _tlOoptions _tlOorderedTypeSynonyms _tlOtypeConstructors _tlOunboundNames _tlOvalueConstructors _tlOwarnings) + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2696 _hdIunboundNames + _tlOunboundNames = rule2697 _lhsIunboundNames + _hdOunboundNames = rule2698 _tlIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2699 _hdIcollectInstances _tlIcollectInstances + _self = rule2700 _hdIself _tlIself + _lhsOself :: Statements + _lhsOself = rule2701 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2702 _tlIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2703 _tlIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2704 _tlIkindErrors + _lhsOlastStatementIsExpr :: Bool + _lhsOlastStatementIsExpr = rule2705 _tlIlastStatementIsExpr + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2706 _tlImiscerrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2707 _tlInamesInScope + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2708 _tlIwarnings + _hdOallTypeConstructors = rule2709 _lhsIallTypeConstructors + _hdOallValueConstructors = rule2710 _lhsIallValueConstructors + _hdOclassEnvironment = rule2711 _lhsIclassEnvironment + _hdOcollectScopeInfos = rule2712 _lhsIcollectScopeInfos + _hdOcounter = rule2713 _lhsIcounter + _hdOkindErrors = rule2714 _lhsIkindErrors + _hdOlastStatementIsExpr = rule2715 _lhsIlastStatementIsExpr + _hdOmiscerrors = rule2716 _lhsImiscerrors + _hdOnamesInScope = rule2717 _lhsInamesInScope + _hdOoptions = rule2718 _lhsIoptions + _hdOorderedTypeSynonyms = rule2719 _lhsIorderedTypeSynonyms + _hdOtypeConstructors = rule2720 _lhsItypeConstructors + _hdOvalueConstructors = rule2721 _lhsIvalueConstructors + _hdOwarnings = rule2722 _lhsIwarnings + _tlOallTypeConstructors = rule2723 _lhsIallTypeConstructors + _tlOallValueConstructors = rule2724 _lhsIallValueConstructors + _tlOclassEnvironment = rule2725 _lhsIclassEnvironment + _tlOcollectScopeInfos = rule2726 _hdIcollectScopeInfos + _tlOcounter = rule2727 _hdIcounter + _tlOkindErrors = rule2728 _hdIkindErrors + _tlOlastStatementIsExpr = rule2729 _hdIlastStatementIsExpr + _tlOmiscerrors = rule2730 _hdImiscerrors + _tlOnamesInScope = rule2731 _hdInamesInScope + _tlOoptions = rule2732 _lhsIoptions + _tlOorderedTypeSynonyms = rule2733 _lhsIorderedTypeSynonyms + _tlOtypeConstructors = rule2734 _lhsItypeConstructors + _tlOvalueConstructors = rule2735 _lhsIvalueConstructors + _tlOwarnings = rule2736 _hdIwarnings + __result_ = T_Statements_vOut157 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOlastStatementIsExpr _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule2696 #-} + rule2696 = \ ((_hdIunboundNames) :: Names) -> + _hdIunboundNames + {-# INLINE rule2697 #-} + rule2697 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule2698 #-} + rule2698 = \ ((_tlIunboundNames) :: Names) -> + _tlIunboundNames + {-# INLINE rule2699 #-} + rule2699 = \ ((_hdIcollectInstances) :: [(Name, Instance)]) ((_tlIcollectInstances) :: [(Name, Instance)]) -> + _hdIcollectInstances ++ _tlIcollectInstances + {-# INLINE rule2700 #-} + rule2700 = \ ((_hdIself) :: Statement) ((_tlIself) :: Statements) -> + (:) _hdIself _tlIself + {-# INLINE rule2701 #-} + rule2701 = \ _self -> + _self + {-# INLINE rule2702 #-} + rule2702 = \ ((_tlIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _tlIcollectScopeInfos + {-# INLINE rule2703 #-} + rule2703 = \ ((_tlIcounter) :: Int) -> + _tlIcounter + {-# INLINE rule2704 #-} + rule2704 = \ ((_tlIkindErrors) :: [Error]) -> + _tlIkindErrors + {-# INLINE rule2705 #-} + rule2705 = \ ((_tlIlastStatementIsExpr) :: Bool) -> + _tlIlastStatementIsExpr + {-# INLINE rule2706 #-} + rule2706 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule2707 #-} + rule2707 = \ ((_tlInamesInScope) :: Names) -> + _tlInamesInScope + {-# INLINE rule2708 #-} + rule2708 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule2709 #-} + rule2709 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2710 #-} + rule2710 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2711 #-} + rule2711 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2712 #-} + rule2712 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2713 #-} + rule2713 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2714 #-} + rule2714 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2715 #-} + rule2715 = \ ((_lhsIlastStatementIsExpr) :: Bool) -> + _lhsIlastStatementIsExpr + {-# INLINE rule2716 #-} + rule2716 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2717 #-} + rule2717 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2718 #-} + rule2718 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2719 #-} + rule2719 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2720 #-} + rule2720 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2721 #-} + rule2721 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2722 #-} + rule2722 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2723 #-} + rule2723 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2724 #-} + rule2724 = \ ((_lhsIallValueConstructors) :: Names) -> + _lhsIallValueConstructors + {-# INLINE rule2725 #-} + rule2725 = \ ((_lhsIclassEnvironment) :: ClassEnvironment) -> + _lhsIclassEnvironment + {-# INLINE rule2726 #-} + rule2726 = \ ((_hdIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _hdIcollectScopeInfos + {-# INLINE rule2727 #-} + rule2727 = \ ((_hdIcounter) :: Int) -> + _hdIcounter + {-# INLINE rule2728 #-} + rule2728 = \ ((_hdIkindErrors) :: [Error]) -> + _hdIkindErrors + {-# INLINE rule2729 #-} + rule2729 = \ ((_hdIlastStatementIsExpr) :: Bool) -> + _hdIlastStatementIsExpr + {-# INLINE rule2730 #-} + rule2730 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule2731 #-} + rule2731 = \ ((_hdInamesInScope) :: Names) -> + _hdInamesInScope + {-# INLINE rule2732 #-} + rule2732 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2733 #-} + rule2733 = \ ((_lhsIorderedTypeSynonyms) :: OrderedTypeSynonyms) -> + _lhsIorderedTypeSynonyms + {-# INLINE rule2734 #-} + rule2734 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2735 #-} + rule2735 = \ ((_lhsIvalueConstructors) :: M.Map Name TpScheme) -> + _lhsIvalueConstructors + {-# INLINE rule2736 #-} + rule2736 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_Statements_Nil #-} +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 _lhsIallTypeConstructors _lhsIallValueConstructors _lhsIclassEnvironment _lhsIcollectScopeInfos _lhsIcounter _lhsIkindErrors _lhsIlastStatementIsExpr _lhsImiscerrors _lhsInamesInScope _lhsIoptions _lhsIorderedTypeSynonyms _lhsItypeConstructors _lhsIunboundNames _lhsIvalueConstructors _lhsIwarnings) -> ( let + _lhsOunboundNames :: Names + _lhsOunboundNames = rule2737 _lhsIunboundNames + _lhsOcollectInstances :: [(Name, Instance)] + _lhsOcollectInstances = rule2738 () + _self = rule2739 () + _lhsOself :: Statements + _lhsOself = rule2740 _self + _lhsOcollectScopeInfos :: [(ScopeInfo, Entity)] + _lhsOcollectScopeInfos = rule2741 _lhsIcollectScopeInfos + _lhsOcounter :: Int + _lhsOcounter = rule2742 _lhsIcounter + _lhsOkindErrors :: [Error] + _lhsOkindErrors = rule2743 _lhsIkindErrors + _lhsOlastStatementIsExpr :: Bool + _lhsOlastStatementIsExpr = rule2744 _lhsIlastStatementIsExpr + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2745 _lhsImiscerrors + _lhsOnamesInScope :: Names + _lhsOnamesInScope = rule2746 _lhsInamesInScope + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2747 _lhsIwarnings + __result_ = T_Statements_vOut157 _lhsOcollectInstances _lhsOcollectScopeInfos _lhsOcounter _lhsOkindErrors _lhsOlastStatementIsExpr _lhsOmiscerrors _lhsOnamesInScope _lhsOself _lhsOunboundNames _lhsOwarnings + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule2737 #-} + rule2737 = \ ((_lhsIunboundNames) :: Names) -> + _lhsIunboundNames + {-# INLINE rule2738 #-} + rule2738 = \ (_ :: ()) -> + [] + {-# INLINE rule2739 #-} + rule2739 = \ (_ :: ()) -> + [] + {-# INLINE rule2740 #-} + rule2740 = \ _self -> + _self + {-# INLINE rule2741 #-} + rule2741 = \ ((_lhsIcollectScopeInfos) :: [(ScopeInfo, Entity)]) -> + _lhsIcollectScopeInfos + {-# INLINE rule2742 #-} + rule2742 = \ ((_lhsIcounter) :: Int) -> + _lhsIcounter + {-# INLINE rule2743 #-} + rule2743 = \ ((_lhsIkindErrors) :: [Error]) -> + _lhsIkindErrors + {-# INLINE rule2744 #-} + rule2744 = \ ((_lhsIlastStatementIsExpr) :: Bool) -> + _lhsIlastStatementIsExpr + {-# INLINE rule2745 #-} + rule2745 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2746 #-} + rule2746 = \ ((_lhsInamesInScope) :: Names) -> + _lhsInamesInScope + {-# INLINE rule2747 #-} + rule2747 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Strings ----------------------------------------------------- +-- wrapper +data Inh_Strings = Inh_Strings { } +data Syn_Strings = Syn_Strings { self_Syn_Strings :: (Strings) } +{-# INLINABLE wrap_Strings #-} +wrap_Strings :: T_Strings -> Inh_Strings -> (Syn_Strings ) +wrap_Strings (T_Strings act) (Inh_Strings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Strings_vIn160 + (T_Strings_vOut160 _lhsOself) <- return (inv_Strings_s161 sem arg) + return (Syn_Strings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Strings #-} +sem_Strings :: Strings -> T_Strings +sem_Strings list = Prelude.foldr sem_Strings_Cons sem_Strings_Nil list + +-- semantic domain +newtype T_Strings = T_Strings { + attach_T_Strings :: Identity (T_Strings_s161 ) + } +newtype T_Strings_s161 = C_Strings_s161 { + inv_Strings_s161 :: (T_Strings_v160 ) + } +data T_Strings_s162 = C_Strings_s162 +type T_Strings_v160 = (T_Strings_vIn160 ) -> (T_Strings_vOut160 ) +data T_Strings_vIn160 = T_Strings_vIn160 +data T_Strings_vOut160 = T_Strings_vOut160 (Strings) +{-# NOINLINE sem_Strings_Cons #-} +sem_Strings_Cons :: (String) -> T_Strings -> T_Strings +sem_Strings_Cons arg_hd_ arg_tl_ = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _tlX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_tl_)) + (T_Strings_vOut160 _tlIself) = inv_Strings_s161 _tlX161 (T_Strings_vIn160 ) + _self = rule2748 _tlIself arg_hd_ + _lhsOself :: Strings + _lhsOself = rule2749 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule2748 #-} + rule2748 = \ ((_tlIself) :: Strings) hd_ -> + (:) hd_ _tlIself + {-# INLINE rule2749 #-} + rule2749 = \ _self -> + _self +{-# NOINLINE sem_Strings_Nil #-} +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _self = rule2750 () + _lhsOself :: Strings + _lhsOself = rule2751 _self + __result_ = T_Strings_vOut160 _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule2750 #-} + rule2750 = \ (_ :: ()) -> + [] + {-# INLINE rule2751 #-} + rule2751 = \ _self -> + _self + +-- Type -------------------------------------------------------- +-- wrapper +data Inh_Type = Inh_Type { allTypeConstructors_Inh_Type :: (Names), miscerrors_Inh_Type :: ([Error]), options_Inh_Type :: ([Option]), typeConstructors_Inh_Type :: (M.Map Name Int), warnings_Inh_Type :: ([Warning]) } +data Syn_Type = Syn_Type { contextRange_Syn_Type :: (Range), miscerrors_Syn_Type :: ([Error]), self_Syn_Type :: (Type), typevariables_Syn_Type :: (Names), warnings_Syn_Type :: ([Warning]) } +{-# INLINABLE wrap_Type #-} +wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) +wrap_Type (T_Type act) (Inh_Type _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Type_vIn163 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings + (T_Type_vOut163 _lhsOcontextRange _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings) <- return (inv_Type_s164 sem arg) + return (Syn_Type _lhsOcontextRange _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Type #-} +sem_Type :: Type -> T_Type +sem_Type ( Type_Application range_ prefix_ function_ arguments_ ) = sem_Type_Application ( sem_Range range_ ) prefix_ ( sem_Type function_ ) ( sem_Types arguments_ ) +sem_Type ( Type_Variable range_ name_ ) = sem_Type_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Constructor range_ name_ ) = sem_Type_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Qualified range_ context_ type_ ) = sem_Type_Qualified ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Type type_ ) +sem_Type ( Type_Forall range_ typevariables_ type_ ) = sem_Type_Forall ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Exists range_ typevariables_ type_ ) = sem_Type_Exists ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Parenthesized range_ type_ ) = sem_Type_Parenthesized ( sem_Range range_ ) ( sem_Type type_ ) + +-- semantic domain +newtype T_Type = T_Type { + attach_T_Type :: Identity (T_Type_s164 ) + } +newtype T_Type_s164 = C_Type_s164 { + inv_Type_s164 :: (T_Type_v163 ) + } +data T_Type_s165 = C_Type_s165 +type T_Type_v163 = (T_Type_vIn163 ) -> (T_Type_vOut163 ) +data T_Type_vIn163 = T_Type_vIn163 (Names) ([Error]) ([Option]) (M.Map Name Int) ([Warning]) +data T_Type_vOut163 = T_Type_vOut163 (Range) ([Error]) (Type) (Names) ([Warning]) +{-# NOINLINE sem_Type_Application #-} +sem_Type_Application :: T_Range -> (Bool) -> T_Type -> T_Types -> T_Type +sem_Type_Application arg_range_ arg_prefix_ arg_function_ arg_arguments_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_function_)) + _argumentsX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _functionIcontextRange _functionImiscerrors _functionIself _functionItypevariables _functionIwarnings) = inv_Type_s164 _functionX164 (T_Type_vIn163 _functionOallTypeConstructors _functionOmiscerrors _functionOoptions _functionOtypeConstructors _functionOwarnings) + (T_Types_vOut166 _argumentsImiscerrors _argumentsIself _argumentsItypevariables _argumentsIwarnings) = inv_Types_s167 _argumentsX167 (T_Types_vIn166 _argumentsOallTypeConstructors _argumentsOmiscerrors _argumentsOoptions _argumentsOtypeConstructors _argumentsOwarnings) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule2752 _argumentsItypevariables _functionItypevariables + _self = rule2753 _argumentsIself _functionIself _rangeIself arg_prefix_ + _lhsOself :: Type + _lhsOself = rule2754 _self + _lhsOcontextRange :: Range + _lhsOcontextRange = rule2755 _functionIcontextRange + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2756 _argumentsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2757 _argumentsIwarnings + _functionOallTypeConstructors = rule2758 _lhsIallTypeConstructors + _functionOmiscerrors = rule2759 _lhsImiscerrors + _functionOoptions = rule2760 _lhsIoptions + _functionOtypeConstructors = rule2761 _lhsItypeConstructors + _functionOwarnings = rule2762 _lhsIwarnings + _argumentsOallTypeConstructors = rule2763 _lhsIallTypeConstructors + _argumentsOmiscerrors = rule2764 _functionImiscerrors + _argumentsOoptions = rule2765 _lhsIoptions + _argumentsOtypeConstructors = rule2766 _lhsItypeConstructors + _argumentsOwarnings = rule2767 _functionIwarnings + __result_ = T_Type_vOut163 _lhsOcontextRange _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule2752 #-} + rule2752 = \ ((_argumentsItypevariables) :: Names) ((_functionItypevariables) :: Names) -> + _functionItypevariables ++ _argumentsItypevariables + {-# INLINE rule2753 #-} + rule2753 = \ ((_argumentsIself) :: Types) ((_functionIself) :: Type) ((_rangeIself) :: Range) prefix_ -> + Type_Application _rangeIself prefix_ _functionIself _argumentsIself + {-# INLINE rule2754 #-} + rule2754 = \ _self -> + _self + {-# INLINE rule2755 #-} + rule2755 = \ ((_functionIcontextRange) :: Range) -> + _functionIcontextRange + {-# INLINE rule2756 #-} + rule2756 = \ ((_argumentsImiscerrors) :: [Error]) -> + _argumentsImiscerrors + {-# INLINE rule2757 #-} + rule2757 = \ ((_argumentsIwarnings) :: [Warning]) -> + _argumentsIwarnings + {-# INLINE rule2758 #-} + rule2758 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2759 #-} + rule2759 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2760 #-} + rule2760 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2761 #-} + rule2761 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2762 #-} + rule2762 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2763 #-} + rule2763 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2764 #-} + rule2764 = \ ((_functionImiscerrors) :: [Error]) -> + _functionImiscerrors + {-# INLINE rule2765 #-} + rule2765 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2766 #-} + rule2766 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2767 #-} + rule2767 = \ ((_functionIwarnings) :: [Warning]) -> + _functionIwarnings +{-# NOINLINE sem_Type_Variable #-} +sem_Type_Variable :: T_Range -> T_Name -> T_Type +sem_Type_Variable arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule2768 _nameIself + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2769 _lhsIallTypeConstructors _lhsIwarnings _nameIself + _lhsOcontextRange :: Range + _lhsOcontextRange = rule2770 () + _self = rule2771 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule2772 _self + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2773 _lhsImiscerrors + __result_ = T_Type_vOut163 _lhsOcontextRange _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule2768 #-} + rule2768 = \ ((_nameIself) :: Name) -> + [ _nameIself ] + {-# INLINE rule2769 #-} + rule2769 = \ ((_lhsIallTypeConstructors) :: Names) ((_lhsIwarnings) :: [Warning]) ((_nameIself) :: Name) -> + let xs = [ SuspiciousTypeVariable _nameIself tc + | length (show _nameIself) > 1 + , tc <- _lhsIallTypeConstructors + , capitalize (show _nameIself) == (show tc) + ] + in xs ++ _lhsIwarnings + {-# INLINE rule2770 #-} + rule2770 = \ (_ :: ()) -> + noRange + {-# INLINE rule2771 #-} + rule2771 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Variable _rangeIself _nameIself + {-# INLINE rule2772 #-} + rule2772 = \ _self -> + _self + {-# INLINE rule2773 #-} + rule2773 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors +{-# NOINLINE sem_Type_Constructor #-} +sem_Type_Constructor :: T_Range -> T_Name -> T_Type +sem_Type_Constructor arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _lhsOcontextRange :: Range + _lhsOcontextRange = rule2774 () + _lhsOtypevariables :: Names + _lhsOtypevariables = rule2775 () + _self = rule2776 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule2777 _self + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2778 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2779 _lhsIwarnings + __result_ = T_Type_vOut163 _lhsOcontextRange _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule2774 #-} + rule2774 = \ (_ :: ()) -> + noRange + {-# INLINE rule2775 #-} + rule2775 = \ (_ :: ()) -> + [] + {-# INLINE rule2776 #-} + rule2776 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Constructor _rangeIself _nameIself + {-# INLINE rule2777 #-} + rule2777 = \ _self -> + _self + {-# INLINE rule2778 #-} + rule2778 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2779 #-} + rule2779 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Type_Qualified #-} +sem_Type_Qualified :: T_Range -> T_ContextItems -> T_Type -> T_Type +sem_Type_Qualified arg_range_ arg_context_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIcontextRanges _contextIcontextVars _contextImiscerrors _contextIself _contextIwarnings) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 _contextOallTypeConstructors _contextOmiscerrors _contextOoptions _contextOtypeConstructors _contextOwarnings) + (T_Type_vOut163 _typeIcontextRange _typeImiscerrors _typeIself _typeItypevariables _typeIwarnings) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOallTypeConstructors _typeOmiscerrors _typeOoptions _typeOtypeConstructors _typeOwarnings) + _lhsOcontextRange :: Range + _lhsOcontextRange = rule2780 _contextIcontextRanges + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2781 _contextIcontextVars _lhsIoptions _rangeIself _typeImiscerrors _typeItypevariables + _lhsOtypevariables :: Names + _lhsOtypevariables = rule2782 _typeItypevariables + _self = rule2783 _contextIself _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule2784 _self + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2785 _typeIwarnings + _contextOallTypeConstructors = rule2786 _lhsIallTypeConstructors + _contextOmiscerrors = rule2787 _lhsImiscerrors + _contextOoptions = rule2788 _lhsIoptions + _contextOtypeConstructors = rule2789 _lhsItypeConstructors + _contextOwarnings = rule2790 _lhsIwarnings + _typeOallTypeConstructors = rule2791 _lhsIallTypeConstructors + _typeOmiscerrors = rule2792 _contextImiscerrors + _typeOoptions = rule2793 _lhsIoptions + _typeOtypeConstructors = rule2794 _lhsItypeConstructors + _typeOwarnings = rule2795 _contextIwarnings + __result_ = T_Type_vOut163 _lhsOcontextRange _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule2780 #-} + rule2780 = \ ((_contextIcontextRanges) :: [Range]) -> + if null _contextIcontextRanges + then noRange + else foldr1 mergeRanges _contextIcontextRanges + {-# INLINE rule2781 #-} + rule2781 = \ ((_contextIcontextVars) :: [Name]) ((_lhsIoptions) :: [Option]) ((_rangeIself) :: Range) ((_typeImiscerrors) :: [Error]) ((_typeItypevariables) :: Names) -> + ( if Overloading `elem` _lhsIoptions then + [ AmbiguousContext v | v <- _contextIcontextVars, v `notElem` _typeItypevariables ] + else + [ OverloadingDisabled _rangeIself ] + ) + ++ + _typeImiscerrors + {-# INLINE rule2782 #-} + rule2782 = \ ((_typeItypevariables) :: Names) -> + _typeItypevariables + {-# INLINE rule2783 #-} + rule2783 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Qualified _rangeIself _contextIself _typeIself + {-# INLINE rule2784 #-} + rule2784 = \ _self -> + _self + {-# INLINE rule2785 #-} + rule2785 = \ ((_typeIwarnings) :: [Warning]) -> + _typeIwarnings + {-# INLINE rule2786 #-} + rule2786 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2787 #-} + rule2787 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2788 #-} + rule2788 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2789 #-} + rule2789 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2790 #-} + rule2790 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2791 #-} + rule2791 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2792 #-} + rule2792 = \ ((_contextImiscerrors) :: [Error]) -> + _contextImiscerrors + {-# INLINE rule2793 #-} + rule2793 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2794 #-} + rule2794 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2795 #-} + rule2795 = \ ((_contextIwarnings) :: [Warning]) -> + _contextIwarnings +{-# NOINLINE sem_Type_Forall #-} +sem_Type_Forall :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Forall arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIcontextRange _typeImiscerrors _typeIself _typeItypevariables _typeIwarnings) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOallTypeConstructors _typeOmiscerrors _typeOoptions _typeOtypeConstructors _typeOwarnings) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule2796 _typeItypevariables + _self = rule2797 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule2798 _self + _lhsOcontextRange :: Range + _lhsOcontextRange = rule2799 _typeIcontextRange + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2800 _typeImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2801 _typeIwarnings + _typeOallTypeConstructors = rule2802 _lhsIallTypeConstructors + _typeOmiscerrors = rule2803 _lhsImiscerrors + _typeOoptions = rule2804 _lhsIoptions + _typeOtypeConstructors = rule2805 _lhsItypeConstructors + _typeOwarnings = rule2806 _lhsIwarnings + __result_ = T_Type_vOut163 _lhsOcontextRange _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule2796 #-} + rule2796 = \ ((_typeItypevariables) :: Names) -> + _typeItypevariables + {-# INLINE rule2797 #-} + rule2797 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Forall _rangeIself _typevariablesIself _typeIself + {-# INLINE rule2798 #-} + rule2798 = \ _self -> + _self + {-# INLINE rule2799 #-} + rule2799 = \ ((_typeIcontextRange) :: Range) -> + _typeIcontextRange + {-# INLINE rule2800 #-} + rule2800 = \ ((_typeImiscerrors) :: [Error]) -> + _typeImiscerrors + {-# INLINE rule2801 #-} + rule2801 = \ ((_typeIwarnings) :: [Warning]) -> + _typeIwarnings + {-# INLINE rule2802 #-} + rule2802 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2803 #-} + rule2803 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2804 #-} + rule2804 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2805 #-} + rule2805 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2806 #-} + rule2806 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Type_Exists #-} +sem_Type_Exists :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Exists arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIcontextRange _typeImiscerrors _typeIself _typeItypevariables _typeIwarnings) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOallTypeConstructors _typeOmiscerrors _typeOoptions _typeOtypeConstructors _typeOwarnings) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule2807 _typeItypevariables + _self = rule2808 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule2809 _self + _lhsOcontextRange :: Range + _lhsOcontextRange = rule2810 _typeIcontextRange + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2811 _typeImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2812 _typeIwarnings + _typeOallTypeConstructors = rule2813 _lhsIallTypeConstructors + _typeOmiscerrors = rule2814 _lhsImiscerrors + _typeOoptions = rule2815 _lhsIoptions + _typeOtypeConstructors = rule2816 _lhsItypeConstructors + _typeOwarnings = rule2817 _lhsIwarnings + __result_ = T_Type_vOut163 _lhsOcontextRange _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule2807 #-} + rule2807 = \ ((_typeItypevariables) :: Names) -> + _typeItypevariables + {-# INLINE rule2808 #-} + rule2808 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Exists _rangeIself _typevariablesIself _typeIself + {-# INLINE rule2809 #-} + rule2809 = \ _self -> + _self + {-# INLINE rule2810 #-} + rule2810 = \ ((_typeIcontextRange) :: Range) -> + _typeIcontextRange + {-# INLINE rule2811 #-} + rule2811 = \ ((_typeImiscerrors) :: [Error]) -> + _typeImiscerrors + {-# INLINE rule2812 #-} + rule2812 = \ ((_typeIwarnings) :: [Warning]) -> + _typeIwarnings + {-# INLINE rule2813 #-} + rule2813 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2814 #-} + rule2814 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2815 #-} + rule2815 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2816 #-} + rule2816 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2817 #-} + rule2817 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings +{-# NOINLINE sem_Type_Parenthesized #-} +sem_Type_Parenthesized :: T_Range -> T_Type -> T_Type +sem_Type_Parenthesized arg_range_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIcontextRange _typeImiscerrors _typeIself _typeItypevariables _typeIwarnings) = inv_Type_s164 _typeX164 (T_Type_vIn163 _typeOallTypeConstructors _typeOmiscerrors _typeOoptions _typeOtypeConstructors _typeOwarnings) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule2818 _typeItypevariables + _self = rule2819 _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule2820 _self + _lhsOcontextRange :: Range + _lhsOcontextRange = rule2821 _typeIcontextRange + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2822 _typeImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2823 _typeIwarnings + _typeOallTypeConstructors = rule2824 _lhsIallTypeConstructors + _typeOmiscerrors = rule2825 _lhsImiscerrors + _typeOoptions = rule2826 _lhsIoptions + _typeOtypeConstructors = rule2827 _lhsItypeConstructors + _typeOwarnings = rule2828 _lhsIwarnings + __result_ = T_Type_vOut163 _lhsOcontextRange _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule2818 #-} + rule2818 = \ ((_typeItypevariables) :: Names) -> + _typeItypevariables + {-# INLINE rule2819 #-} + rule2819 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Parenthesized _rangeIself _typeIself + {-# INLINE rule2820 #-} + rule2820 = \ _self -> + _self + {-# INLINE rule2821 #-} + rule2821 = \ ((_typeIcontextRange) :: Range) -> + _typeIcontextRange + {-# INLINE rule2822 #-} + rule2822 = \ ((_typeImiscerrors) :: [Error]) -> + _typeImiscerrors + {-# INLINE rule2823 #-} + rule2823 = \ ((_typeIwarnings) :: [Warning]) -> + _typeIwarnings + {-# INLINE rule2824 #-} + rule2824 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2825 #-} + rule2825 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2826 #-} + rule2826 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2827 #-} + rule2827 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2828 #-} + rule2828 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + +-- Types ------------------------------------------------------- +-- wrapper +data Inh_Types = Inh_Types { allTypeConstructors_Inh_Types :: (Names), miscerrors_Inh_Types :: ([Error]), options_Inh_Types :: ([Option]), typeConstructors_Inh_Types :: (M.Map Name Int), warnings_Inh_Types :: ([Warning]) } +data Syn_Types = Syn_Types { miscerrors_Syn_Types :: ([Error]), self_Syn_Types :: (Types), typevariables_Syn_Types :: (Names), warnings_Syn_Types :: ([Warning]) } +{-# INLINABLE wrap_Types #-} +wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) +wrap_Types (T_Types act) (Inh_Types _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Types_vIn166 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings + (T_Types_vOut166 _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings) <- return (inv_Types_s167 sem arg) + return (Syn_Types _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings) + ) + +-- cata +{-# NOINLINE sem_Types #-} +sem_Types :: Types -> T_Types +sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) + +-- semantic domain +newtype T_Types = T_Types { + attach_T_Types :: Identity (T_Types_s167 ) + } +newtype T_Types_s167 = C_Types_s167 { + inv_Types_s167 :: (T_Types_v166 ) + } +data T_Types_s168 = C_Types_s168 +type T_Types_v166 = (T_Types_vIn166 ) -> (T_Types_vOut166 ) +data T_Types_vIn166 = T_Types_vIn166 (Names) ([Error]) ([Option]) (M.Map Name Int) ([Warning]) +data T_Types_vOut166 = T_Types_vOut166 ([Error]) (Types) (Names) ([Warning]) +{-# NOINLINE sem_Types_Cons #-} +sem_Types_Cons :: T_Type -> T_Types -> T_Types +sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _hdX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) + _tlX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) + (T_Type_vOut163 _hdIcontextRange _hdImiscerrors _hdIself _hdItypevariables _hdIwarnings) = inv_Type_s164 _hdX164 (T_Type_vIn163 _hdOallTypeConstructors _hdOmiscerrors _hdOoptions _hdOtypeConstructors _hdOwarnings) + (T_Types_vOut166 _tlImiscerrors _tlIself _tlItypevariables _tlIwarnings) = inv_Types_s167 _tlX167 (T_Types_vIn166 _tlOallTypeConstructors _tlOmiscerrors _tlOoptions _tlOtypeConstructors _tlOwarnings) + _lhsOtypevariables :: Names + _lhsOtypevariables = rule2829 _hdItypevariables _tlItypevariables + _self = rule2830 _hdIself _tlIself + _lhsOself :: Types + _lhsOself = rule2831 _self + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2832 _tlImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2833 _tlIwarnings + _hdOallTypeConstructors = rule2834 _lhsIallTypeConstructors + _hdOmiscerrors = rule2835 _lhsImiscerrors + _hdOoptions = rule2836 _lhsIoptions + _hdOtypeConstructors = rule2837 _lhsItypeConstructors + _hdOwarnings = rule2838 _lhsIwarnings + _tlOallTypeConstructors = rule2839 _lhsIallTypeConstructors + _tlOmiscerrors = rule2840 _hdImiscerrors + _tlOoptions = rule2841 _lhsIoptions + _tlOtypeConstructors = rule2842 _lhsItypeConstructors + _tlOwarnings = rule2843 _hdIwarnings + __result_ = T_Types_vOut166 _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule2829 #-} + rule2829 = \ ((_hdItypevariables) :: Names) ((_tlItypevariables) :: Names) -> + _hdItypevariables ++ _tlItypevariables + {-# INLINE rule2830 #-} + rule2830 = \ ((_hdIself) :: Type) ((_tlIself) :: Types) -> + (:) _hdIself _tlIself + {-# INLINE rule2831 #-} + rule2831 = \ _self -> + _self + {-# INLINE rule2832 #-} + rule2832 = \ ((_tlImiscerrors) :: [Error]) -> + _tlImiscerrors + {-# INLINE rule2833 #-} + rule2833 = \ ((_tlIwarnings) :: [Warning]) -> + _tlIwarnings + {-# INLINE rule2834 #-} + rule2834 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2835 #-} + rule2835 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2836 #-} + rule2836 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2837 #-} + rule2837 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2838 #-} + rule2838 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings + {-# INLINE rule2839 #-} + rule2839 = \ ((_lhsIallTypeConstructors) :: Names) -> + _lhsIallTypeConstructors + {-# INLINE rule2840 #-} + rule2840 = \ ((_hdImiscerrors) :: [Error]) -> + _hdImiscerrors + {-# INLINE rule2841 #-} + rule2841 = \ ((_lhsIoptions) :: [Option]) -> + _lhsIoptions + {-# INLINE rule2842 #-} + rule2842 = \ ((_lhsItypeConstructors) :: M.Map Name Int) -> + _lhsItypeConstructors + {-# INLINE rule2843 #-} + rule2843 = \ ((_hdIwarnings) :: [Warning]) -> + _hdIwarnings +{-# NOINLINE sem_Types_Nil #-} +sem_Types_Nil :: T_Types +sem_Types_Nil = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 _lhsIallTypeConstructors _lhsImiscerrors _lhsIoptions _lhsItypeConstructors _lhsIwarnings) -> ( let + _lhsOtypevariables :: Names + _lhsOtypevariables = rule2844 () + _self = rule2845 () + _lhsOself :: Types + _lhsOself = rule2846 _self + _lhsOmiscerrors :: [Error] + _lhsOmiscerrors = rule2847 _lhsImiscerrors + _lhsOwarnings :: [Warning] + _lhsOwarnings = rule2848 _lhsIwarnings + __result_ = T_Types_vOut166 _lhsOmiscerrors _lhsOself _lhsOtypevariables _lhsOwarnings + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule2844 #-} + rule2844 = \ (_ :: ()) -> + [] + {-# INLINE rule2845 #-} + rule2845 = \ (_ :: ()) -> + [] + {-# INLINE rule2846 #-} + rule2846 = \ _self -> + _self + {-# INLINE rule2847 #-} + rule2847 = \ ((_lhsImiscerrors) :: [Error]) -> + _lhsImiscerrors + {-# INLINE rule2848 #-} + rule2848 = \ ((_lhsIwarnings) :: [Warning]) -> + _lhsIwarnings diff --git a/src/Helium/StaticAnalysis/StaticChecks/TopLevelErrors.ag b/src/Helium/StaticAnalysis/StaticChecks/TopLevelErrors.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/StaticChecks/TopLevelErrors.ag @@ -0,0 +1,90 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- Collect static errors that are detected at top-level. +-- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- All Top-Level Errors + +SEM Module + | Module loc . topLevelErrors = concat [ @typeConstructorErrors + , @valueConstructorErrors + , @fixityErrors + , @fixityButNoFunDefErrors + , @wrongFlagErrors + , @recursiveTypeSynonymErrors + , @wrongFileNameErrors + ] + +------------------------------------------------------------------------------ +-- duplicated type constructors + +SEM Module + | Module loc . typeConstructorErrors = makeDuplicated TypeConstructor @duplicatedTypeConstructors + +------------------------------------------------------------------------------ +-- duplicated value constructors + +SEM Module + | Module loc . valueConstructorErrors = makeDuplicated Constructor @duplicatedValueConstructors + +------------------------------------------------------------------------------ +-- duplicated fixity declarations + +SEM Module + | Module loc . fixityErrors = makeDuplicated Fixity @duplicatedFixities + . (duplicatedFixities,correctFixities) = let (xs,ys) = partition ((>1) . length) . group . sort $ (map fst @body.operatorFixities) + in (xs,map head ys) + +------------------------------------------------------------------------------ +-- fixity declarations without a definition + +SEM Module + | Module loc . fixityButNoFunDefErrors = let list = nub (@body.declVarNames ++ @allValueConstructors) + in makeNoFunDef Fixity (filter (`notElem` list) @correctFixities) list + +------------------------------------------------------------------------------ +-- wrong overloading flag is used (w.r.t. imported functions) + +SEM Module + | Module loc . wrongFlagErrors = + [ WrongOverloadingFlag flag + | let flag = Overloading `elem` @lhs.options + imp = any isOverloaded (concatMap (M.elems . typeEnvironment) @lhs.importEnvironments) + , flag /= imp + ] + +------------------------------------------------------------------------------ +-- recursive type synonyms + +SEM Module + | Module loc . recursiveTypeSynonymErrors = + let converted = map (\(name, tuple) -> (show name, tuple)) @body.collectTypeSynonyms + recursives = snd . getTypeSynonymOrdering . M.fromList $ converted + makeError = let f = foldr add (Just []) + add s ml = case (g s, ml) of + ([n], Just ns) -> Just (n:ns) + _ -> Nothing + g s = [ n | n <- map fst @body.collectTypeSynonyms, show n == s ] + in maybe [] (\x -> [RecursiveTypeSynonyms x]) . f + in concatMap makeError recursives + +------------------------------------------------------------------------------ +-- wrong file name (does not match the module name) + +SEM Module + | Module loc . wrongFileNameErrors = let moduleString = getNameName @moduleName + moduleRange = getNameRange @moduleName + in if moduleString == "" || @lhs.baseName == moduleString + then [] + else [ WrongFileName @lhs.baseName moduleString moduleRange ] + . moduleName = case @name.self of + MaybeName_Just name -> name + MaybeName_Nothing -> Name_Identifier noRange [] "" -- !!!Name + . fileName = Name_Identifier noRange [] @lhs.baseName -- !!!Name diff --git a/src/Helium/StaticAnalysis/StaticChecks/Warnings.ag b/src/Helium/StaticAnalysis/StaticChecks/Warnings.ag new file mode 100644 --- /dev/null +++ b/src/Helium/StaticAnalysis/StaticChecks/Warnings.ag @@ -0,0 +1,164 @@ +----------------------------------------------------------------------------- +-- |The Helium Compiler : Static Analysis +-- +-- Maintainer : bastiaan@cs.uu.nl +-- Stability : experimental +-- Portability : unknown +-- +-- The warnings that are collected are the following: +-- 1) Suspicious function bindings (two groups of function bindings are next to each +-- other in the program; the names are similar, but only one has an +-- explicit type signature. Perhaps only one group of function bindings was intended?) +-- 2) Suspicious type variable (a type variable with at least length two that resembles a +-- known type constant) +------------------------------------------------------------------------------- + +ATTR Expression Expressions MaybeExpression Pattern Patterns Alternative Alternatives + Statement Statements Declaration Declarations MaybeDeclarations LeftHandSide RightHandSide + FunctionBinding FunctionBindings Body Qualifier Qualifiers + GuardedExpression GuardedExpressions + Type Types AnnotatedType AnnotatedTypes Constructor Constructors ContextItem ContextItems + [ | warnings : {[Warning]} | ] + +SEM Module + | Module body . warnings = [] + loc . warnings = @body.warnings + +SEM Body + | Body + lhs . warnings = @declarations.warnings ++ + @suspiciousErrors + +SEM Expression + | Let lhs . warnings = @expression.warnings ++ + @suspiciousErrors + +SEM Statement + | Let lhs . warnings = @declarations.warnings ++ + @suspiciousErrors + +SEM Qualifier + | Let lhs . warnings = @declarations.warnings ++ + @suspiciousErrors + +SEM MaybeDeclarations + | Just + lhs . warnings = @declarations.warnings ++ + @suspiciousErrors + +SEM Declaration + | Data + lhs . warnings = map (Unused TypeVariable) @unused ++ @lhs.warnings + + | Type + lhs . warnings = map (Unused TypeVariable) @unused ++ @lhs.warnings + +------------------------------------------- +-- Suspicious Function Bindings + +ATTR Declarations Declaration [ | previousWasAlsoFB:{Maybe Name} suspiciousFBs : {[(Name,Name)]} | ] + +SEM Body + | Body declarations . previousWasAlsoFB = Nothing + . suspiciousFBs = [] + loc . suspiciousErrors = findSimilarFunctionBindings @declarations.typeSignatures @declarations.suspiciousFBs + +SEM MaybeDeclarations + | Just declarations . previousWasAlsoFB = Nothing + . suspiciousFBs = [] + loc . suspiciousErrors = findSimilarFunctionBindings @declarations.typeSignatures @declarations.suspiciousFBs + +SEM Expression + | Let declarations . previousWasAlsoFB = Nothing + . suspiciousFBs = [] + loc . suspiciousErrors = findSimilarFunctionBindings @declarations.typeSignatures @declarations.suspiciousFBs + +SEM Statement + | Let declarations . previousWasAlsoFB = Nothing + . suspiciousFBs = [] + loc . suspiciousErrors = findSimilarFunctionBindings @declarations.typeSignatures @declarations.suspiciousFBs + +SEM Qualifier + | Let declarations . previousWasAlsoFB = Nothing + . suspiciousFBs = [] + loc . suspiciousErrors = findSimilarFunctionBindings @declarations.typeSignatures @declarations.suspiciousFBs + +SEM Declaration + | Type lhs . previousWasAlsoFB = Nothing + | Data lhs . previousWasAlsoFB = Nothing + | Newtype lhs . previousWasAlsoFB = Nothing + | Class lhs . previousWasAlsoFB = Nothing + | Instance lhs . previousWasAlsoFB = Nothing + | Default lhs . previousWasAlsoFB = Nothing + | PatternBinding lhs . previousWasAlsoFB = Nothing + | TypeSignature lhs . previousWasAlsoFB = Nothing + | Fixity lhs . previousWasAlsoFB = Nothing + | FunctionBindings lhs . previousWasAlsoFB = Just @bindings.name + . suspiciousFBs = case @lhs.previousWasAlsoFB of + Just name | show name `similar` show @bindings.name + -> (name,@bindings.name) : @lhs.suspiciousFBs + _ -> @lhs.suspiciousFBs + +{ +findSimilarFunctionBindings :: [(Name, TpScheme)] -> [(Name,Name)] -> [Warning] +findSimilarFunctionBindings environment candidates = + let namesWithTypeDef = map fst environment + in [ uncurry SimilarFunctionBindings pair + | (n1,n2) <- candidates + , let bool1 = n1 `elem` namesWithTypeDef + bool2 = n2 `elem` namesWithTypeDef + pair = if bool1 then (n2,n1) else (n1,n2) + , bool1 `xor` bool2 + ] + +xor :: Bool -> Bool -> Bool +xor b1 b2 = not (b1 == b2) +} + +------------------------------------------- +-- Suspicious Type Variables + +SEM Type + | Variable lhs . warnings = let xs = [ SuspiciousTypeVariable @name.self tc + | length (show @name.self) > 1 + , tc <- @lhs.allTypeConstructors + , capitalize (show @name.self) == (show tc) + ] + in xs ++ @lhs.warnings + + +---------------------------------------------- +-- Context in type signature can be simplified + +SEM ContextItem [ | | contextRanges:{[Range]} ] + | ContextItem lhs.contextRanges = [@range.self] + +SEM ContextItems [ | | contextRanges:{[Range]} ] + | Cons lhs.contextRanges = @hd.contextRanges ++ @tl.contextRanges + | Nil lhs.contextRanges = [] + +SEM Type [ | | contextRange:Range ] + | Qualified lhs.contextRange = if null @context.contextRanges + then noRange + else foldr1 mergeRanges @context.contextRanges + | Constructor lhs.contextRange = noRange + | Variable lhs.contextRange = noRange + +SEM Declaration + | TypeSignature + lhs . warnings = simplifyContext @lhs.orderedTypeSynonyms @type.contextRange @intMap @typeScheme ++ @type.warnings + +{ +simplifyContext :: OrderedTypeSynonyms -> Range -> [(Int, Name)] -> TpScheme -> Warnings +simplifyContext synonyms range intMap typescheme = + let predicates = qualifiers (unquantify typescheme) + reduced = f predicates [] + where f [] as = reverse as -- reverse to original order + f (p:ps) as + | entail synonyms standardClasses (ps++as) p = f ps as + | otherwise = f ps (p:as) + sub = listToSubstitution [ (i, TCon (show n)) | (i, n) <- intMap ] + in if length reduced == length predicates + then [] + else [ ReduceContext range (sub |-> predicates) (sub |-> reduced) ] +} diff --git a/src/Helium/Syntax/UHA_OneLine.ag b/src/Helium/Syntax/UHA_OneLine.ag new file mode 100644 --- /dev/null +++ b/src/Helium/Syntax/UHA_OneLine.ag @@ -0,0 +1,533 @@ +INCLUDE "UHA_Syntax.ag" + +imports{ +import Helium.Utils.OneLiner +import Data.Char +import Helium.Syntax.UHA_Utils (showNameAsOperator) +import Helium.StaticAnalysis.Miscellaneous.TypeConversion +import Helium.Syntax.UHA_Syntax +import Data.List +import Helium.Utils.Utils (internalError, hole) +} + +{ + +encloseSep :: String -> String -> String -> [OneLineTree] -> OneLineTree +encloseSep left _ right [] = OneLineNode [OneLineText left, OneLineText right] +encloseSep left sep right (t:ts) = + OneLineNode ([ OneLineText left] ++ (t : concatMap (\t' -> [OneLineText sep,t']) ts) ++ [OneLineText right] ) + +punctuate :: String -> [OneLineTree] -> OneLineTree +punctuate _ [] = OneLineText "" +punctuate _ [t] = t +punctuate s (t:ts) = OneLineNode (t : concatMap (\t' -> [OneLineText s,t']) ts) + +parens :: OneLineTree -> OneLineTree +parens tree = OneLineNode [ OneLineText "(", tree, OneLineText ")" ] + +sepBy :: OneLineTree -> [OneLineTree] -> [OneLineTree] +sepBy separator list = + intersperse separator (map (\x -> OneLineNode [x]) list) + +intErr :: String -> String -> a +intErr node message = internalError "UHA_OneLine" node message + +oneLineTreeAsOperator :: OneLineTree -> OneLineTree +oneLineTreeAsOperator tree = + case tree of + OneLineNode [OneLineText (first:_)] + | isAlpha first || first == '_' + -> OneLineNode [ OneLineText "`", tree, OneLineText "`" ] + _ -> tree +} + +ATTR + Declaration + Expression Statement + Qualifier Alternative + FunctionBinding LeftHandSide + Pattern Literal Name + [ + | + | oneLineTree : OneLineTree + ] + +ATTR GuardedExpression RightHandSide + [ + | + | oneLineTree : { String -> OneLineTree } + ] + +ATTR GuardedExpressions + [ + | + | oneLineTree USE { : } { [] } : { [ String -> OneLineTree ] } + ] + +ATTR + Declarations Expressions + Statements Qualifiers Alternatives + FunctionBindings Patterns Names Strings + [ + | + | oneLineTree USE { : } { [] } : { [ OneLineTree] } + ] + +ATTR + MaybeExpression [ + | + | oneLineTree : { Maybe OneLineTree } + ] + +ATTR + MaybeDeclarations + [ + | + | oneLineTree : { Maybe [OneLineTree] } + ] + +ATTR + Name + [ | | isOperator, isIdentifier, isSpecial USE { (error "Name has no children!") } { False } : Bool ] + +ATTR + Names + [ | | isOperator, isIdentifier, isSpecial USE { : } { [] } : { [Bool] } ] + +-- ------------------------------------------------------------------------ +-- -- Declarations -- +-- ------------------------------------------------------------------------ + +SEM MaybeDeclarations + | Nothing loc.oneLineTree = Nothing + | Just loc.oneLineTree = Just @declarations.oneLineTree + -- declarations : Declarations + +SEM Declaration {- *** -} + | Hole loc.oneLineTree = OneLineText hole + -- range : Range + -- id : Integer + | Type loc.oneLineTree = intErr "Declaration" "type" + -- range : Range + -- simpletype : SimpleType + -- type : Type + | Data loc.oneLineTree = intErr "Declaration" "data" + -- range : Range {- *** -} + -- context : ContextItems + -- simpletype : SimpleType + -- constructors : Constructors + -- derivings : Names + | Newtype loc.oneLineTree = intErr "Declaration" "newtype" + -- range : Range + -- context : ContextItems + -- simpletype : SimpleType + -- constructor : Constructor -- has only one field, no strictness + -- derivings : Names + | Class loc.oneLineTree = intErr "Declaration" "class" + -- range : Range + -- context : ContextItems -- is a "simple" context + -- simpletype : SimpleType -- Haskell 98 allows only one variable + -- where : MaybeDeclarations -- cannot have everything + | Instance loc.oneLineTree = intErr "Declaration" "instance" + -- range : Range + -- context : ContextItems -- is a "simple" context + -- name : Name + -- types : Types -- Haskell 98 allows only one type + -- that is severely restricted + -- where : MaybeDeclarations -- cannot have everything + | Default loc.oneLineTree = intErr "Declaration" "default" + -- range : Range + -- types : Types -- should be instances of Num + | FunctionBindings loc.oneLineTree = + punctuate ";" @bindings.oneLineTree + -- range : Range {- *** -} + -- bindings : FunctionBindings -- should all be for the same function + | PatternBinding loc.oneLineTree = + OneLineNode + [ OneLineNode [@pattern.oneLineTree] + , OneLineNode [@righthandside.oneLineTree " = "] + ] + -- range : Range + -- pattern : Pattern + -- righthandside : RightHandSide + | TypeSignature loc.oneLineTree = + OneLineNode + [ OneLineText (concat . intersperse "," . map show $ @names.self) + , OneLineText " :: " + , OneLineText (show (makeTpSchemeFromType @type.self)) + ] + -- range : Range + -- names : Names + -- type : Type -- may have context + | Fixity loc.oneLineTree = intErr "Declaration" "fixity" + -- range : Range + -- fixity : Fixity + -- priority : MaybeInt + -- operators : Names + | Empty loc.oneLineTree = OneLineText "" + -- range : Range + +-- ------------------------------------------------------------------------ +-- -- Expressions -- +-- ------------------------------------------------------------------------ + +SEM MaybeExpression + | Nothing loc.oneLineTree = Nothing + | Just loc.oneLineTree = Just @expression.oneLineTree + -- expression : Expression + +SEM Expression {- *** -} + | Literal loc.oneLineTree = OneLineNode [@literal.oneLineTree] + -- range : Range + -- literal : Literal + | Variable loc.oneLineTree = OneLineNode [@name.oneLineTree] + -- range : Range + -- name : Name + | Hole loc.oneLineTree = OneLineNode [OneLineText hole] + -- range : Range + -- id : Integer + | Constructor loc.oneLineTree = OneLineNode [@name.oneLineTree] + -- range : Range + -- name : Name + | Parenthesized loc.oneLineTree = parens @expression.oneLineTree + -- range : Range + -- expression : Expression + | NormalApplication loc.oneLineTree = + punctuate " " (@function.oneLineTree : @arguments.oneLineTree) + -- range : Range + -- function : Expression + -- arguments : Expressions + | InfixApplication loc.operatorName = oneLineTreeAsOperator @operator.oneLineTree + loc.oneLineTree = + case (@leftExpression.oneLineTree, @rightExpression.oneLineTree) of + (Nothing, Nothing) -> parens @operatorName + (Just l , Nothing) -> encloseSep "(" " " ")" [l, @operatorName] + (Nothing, Just r ) -> encloseSep "(" " " ")" [@operatorName, r] + (Just l , Just r ) -> OneLineNode [ l, OneLineText " ", @operatorName, OneLineText " ", r ] + -- range : Range + -- leftExpression : MaybeExpression + -- operator : Expression + -- rightExpression : MaybeExpression + | If loc.oneLineTree = + OneLineNode + [ OneLineText "if " + , OneLineNode [@guardExpression.oneLineTree] + , OneLineText " then " + , OneLineNode [@thenExpression.oneLineTree] + , OneLineText " else " + , OneLineNode [@elseExpression.oneLineTree] + ] + -- range : Range + -- guardExpression : Expression + -- thenExpression : Expression + -- elseExpression : Expression + | Lambda + loc.oneLineTree = + OneLineNode + ( [ OneLineText "\\", punctuate " " @patterns.oneLineTree, OneLineText " -> " + , OneLineNode [@expression.oneLineTree] + ] + ) + -- range : Range + -- patterns : Patterns + -- expression : Expression + | Case loc.oneLineTree = + OneLineNode + [ OneLineText "case " + , OneLineNode [@expression.oneLineTree] + , OneLineText " of " + , encloseSep "{" "; " "}" @alternatives.oneLineTree + ] + -- range : Range + -- expression : Expression + -- alternatives : Alternatives + | Let loc.oneLineTree = + OneLineNode + [ OneLineText "let " + , encloseSep "{" "; " "}" @declarations.oneLineTree + , OneLineText " in " + , OneLineNode [@expression.oneLineTree] + ] + -- range : Range + -- declarations : Declarations + -- expression : Expression + | Do loc.oneLineTree = + OneLineNode + [ OneLineText "do " + , OneLineNode (sepBy (OneLineText "; ") @statements.oneLineTree) + ] + -- range : Range + -- statements : Statements + | List loc.oneLineTree = encloseSep "[" ", " "]" @expressions.oneLineTree + -- range : Range + -- expressions : Expressions + | Tuple loc.oneLineTree = encloseSep "(" ", " ")" @expressions.oneLineTree + -- range : Range + -- expressions : Expressions + | Comprehension + loc.oneLineTree = + OneLineNode + [ OneLineText "[ " + , OneLineNode [@expression.oneLineTree] + , OneLineText " | " + , OneLineNode [ punctuate ", " @qualifiers.oneLineTree ] + , OneLineText " ]" + ] + -- range : Range + -- expression : Expression + -- qualifiers : Qualifiers + | Typed loc.oneLineTree = + OneLineNode + [ OneLineNode [@expression.oneLineTree] + , OneLineText " :: " + , OneLineNode [ OneLineText (show (makeTpSchemeFromType @type.self))] + ] + -- range : Range + -- expression : Expression + -- type : Type + | RecordConstruction + loc.oneLineTree = intErr "Expression" "record construction" + -- range : Range + -- name : Name + -- recordExpressionBindings : RecordExpressionBindings + | RecordUpdate + loc.oneLineTree = intErr "Expression" "record update" + -- range : Range + -- expression : Expression + -- recordExpressionBindings : RecordExpressionBindings + | Enum loc.oneLineTree = + OneLineNode ( + [ OneLineText "[" + , OneLineNode [@from.oneLineTree] + ] + ++ + maybe [] (\x -> [OneLineText ", ", x]) @then.oneLineTree + ++ + [ OneLineText " .. " ] + ++ + maybe [] (\x -> [OneLineNode [x]]) @to.oneLineTree + ++ + [ OneLineText "]" ] + ) + -- range : Range + -- from : Expression + -- then : MaybeExpression + -- to : MaybeExpression + | Negate + loc.oneLineTree = OneLineNode [ OneLineText "-", OneLineNode [@expression.oneLineTree] ] + | NegateFloat + loc.oneLineTree = OneLineNode [ OneLineText "-.", OneLineNode [@expression.oneLineTree] ] + -- range : Range + -- expression : Expression + +SEM Statement + | Expression loc.oneLineTree = @expression.oneLineTree + -- range : Range + -- expression : Expression + | Let loc.oneLineTree = + OneLineNode [ OneLineText "let ", encloseSep "{" "; " "}" @declarations.oneLineTree ] + -- range : Range + -- declarations : Declarations + | Generator loc.oneLineTree = + OneLineNode [ @pattern.oneLineTree, OneLineText " <- ", @expression.oneLineTree ] + -- range : Range + -- pattern : Pattern + -- expression : Expression + | Empty loc.oneLineTree = OneLineText "" + -- range : Range + +SEM Qualifier + | Guard loc.oneLineTree = @guard.oneLineTree + -- range : Range + -- guard : Expression -- type: Boolean + | Let loc.oneLineTree = + OneLineNode [ OneLineText "let ", encloseSep "{" "; " "}" @declarations.oneLineTree ] + -- range : Range + -- declarations : Declarations + | Generator loc.oneLineTree = + OneLineNode [ @pattern.oneLineTree, OneLineText " <- ", @expression.oneLineTree ] + -- range : Range + -- pattern : Pattern + -- expression : Expression + | Empty loc.oneLineTree = OneLineText "" + -- range : Range + +SEM Alternative + | Hole loc.oneLineTree = OneLineText hole + | Alternative loc.oneLineTree = + OneLineNode [ @pattern.oneLineTree, @righthandside.oneLineTree " -> " ] + -- range : Range + -- pattern : Pattern + -- righthandside : RightHandSide + | Empty loc.oneLineTree = OneLineText "" + -- range : Range + +SEM GuardedExpression -- ToDo: or _Guard? + | GuardedExpression loc.oneLineTree = + \assign -> OneLineNode [ OneLineText " | ", @guard.oneLineTree, OneLineText assign, @expression.oneLineTree ] + -- range : Range + -- guard : Expression -- type: Boolean + -- expression : Expression + +SEM FunctionBinding + | Hole loc.oneLineTree = OneLineText hole + | FunctionBinding loc.oneLineTree = + OneLineNode [@lefthandside.oneLineTree, @righthandside.oneLineTree " = " ] + -- range : Range + -- lefthandside : LeftHandSide + -- righthandside : RightHandSide + +SEM LeftHandSide + | Function loc.oneLineTree = punctuate " " (@name.oneLineTree : @patterns.oneLineTree) + -- range : Range + -- name : Name + -- patterns : Patterns + | Infix loc.operatorName = oneLineTreeAsOperator @operator.oneLineTree + loc.oneLineTree = + punctuate " " [@leftPattern.oneLineTree, @operatorName, @rightPattern.oneLineTree] + -- range : Range + -- leftPattern : Pattern + -- operator : Name + -- rightPattern : Pattern + | Parenthesized loc.oneLineTree = + punctuate " " ( parens @lefthandside.oneLineTree : @patterns.oneLineTree ) + -- range : Range + -- lefthandside : LeftHandSide + -- patterns : Patterns + +SEM RightHandSide + | Expression loc.oneLineTree = + \assign -> OneLineNode + ( [ OneLineText assign, @expression.oneLineTree ] + ++ case @where.oneLineTree of + Nothing -> [] + Just ds -> [ OneLineText " where ", encloseSep "{" "; " "}" ds ] + ) + -- range : Range + -- expression : Expression + -- where : MaybeDeclarations + | Guarded loc.oneLineTree = + \assign -> OneLineNode + ( [ ge assign | ge <- @guardedexpressions.oneLineTree ] + ++ case @where.oneLineTree of + Nothing -> [] + Just ds -> [ OneLineText " where ", encloseSep "{" "; " "}" ds ] + ) + -- range : Range + -- guardedexpressions : GuardedExpressions + -- where : MaybeDeclarations + +-- ------------------------------------------------------------------------ +-- -- Patterns -- +-- ------------------------------------------------------------------------ + +SEM Pattern + | Hole + loc.oneLineTree = OneLineText hole + | Literal + loc.oneLineTree = @literal.oneLineTree + -- range : Range + -- literal : Literal + | Variable + loc.oneLineTree = @name.oneLineTree + -- range : Range + -- name : Name + | Constructor + loc.operatorName = if @name.isOperator + then OneLineNode [OneLineText "(", @name.oneLineTree, OneLineText ")"] + else @name.oneLineTree + loc.oneLineTree = OneLineNode (sepBy (OneLineText " ") (@operatorName : @patterns.oneLineTree)) + -- range : Range + -- name : Name + -- patterns : Patterns + | Parenthesized + loc.oneLineTree = parens @pattern.oneLineTree + -- range : Range + -- pattern : Pattern + | InfixConstructor + loc.operatorName = OneLineText (showNameAsOperator @constructorOperator.self) + loc.oneLineTree = + OneLineNode + [ OneLineNode [@leftPattern.oneLineTree] + , OneLineText " " + , OneLineNode [@operatorName] + , OneLineText " " + , OneLineNode [@rightPattern.oneLineTree] + ] + -- range : Range + -- leftPattern : Pattern + -- constructorOperator : Name + -- rightPattern : Pattern + | List loc.oneLineTree = encloseSep "[" ", " "]" @patterns.oneLineTree + -- range : Range + -- patterns : Patterns + | Tuple loc.oneLineTree = encloseSep "(" ", " ")" @patterns.oneLineTree + -- range : Range + -- patterns : Patterns + | Record loc.oneLineTree = intErr "pattern" "record" + -- range : Range + -- name : Name + -- recordPatternBindings : RecordPatternBindings + | Negate loc.oneLineTree = OneLineNode [ OneLineText "-", @literal.oneLineTree ] + -- range : Range + -- literal : Literal -- only numbers allowed here + | NegateFloat loc.oneLineTree = OneLineNode [ OneLineText "-." , @literal.oneLineTree ] + -- range : Range + -- literal : Literal -- only numbers allowed here + | As + loc.oneLineTree = + OneLineNode + [ OneLineNode [@name.oneLineTree] + , OneLineText "@" + , OneLineNode [@pattern.oneLineTree] + ] + -- range : Range + -- name : Name + -- pattern : Pattern + | Wildcard + loc.oneLineTree = OneLineText "_" + -- range : Range + | Irrefutable + loc.oneLineTree = intErr "pattern" "irrefutable" + -- range : Range + -- pattern : Pattern + | Successor + loc.oneLineTree = intErr "pattern" "successor" + -- range : Range + -- name : Name + -- literal : Literal -- only integers allowed here + +-- ------------------------------------------------------------------------ +-- -- Basics -- +-- ------------------------------------------------------------------------ + +SEM Literal {- *** -} + | Int loc.oneLineTree = OneLineText @value + -- range : Range + -- value : String + | Char loc.oneLineTree = OneLineText ("'" ++ @value ++ "'") + -- range : Range + -- value : String -- without the quotes + | Float loc.oneLineTree = OneLineText @value + -- range : Range + -- value : String + | String loc.oneLineTree = OneLineText ("\"" ++ @value ++ "\"") + -- range : Range + -- value : String -- without the quotes + +SEM Name {- *** -} + | Identifier lhs.isIdentifier = True + loc.oneLineTree = OneLineText @name + -- range : Range + -- module : Strings + -- name : String + | Operator lhs.isOperator = True + loc.oneLineTree = OneLineText @name + -- range : Range + -- module : Strings + -- name : String + | Special lhs.isSpecial = True + loc.oneLineTree = OneLineText @name + -- range : Range + -- module : Strings + -- name : String diff --git a/src/Helium/Syntax/UHA_OneLine.hs b/src/Helium/Syntax/UHA_OneLine.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Syntax/UHA_OneLine.hs @@ -0,0 +1,6664 @@ +{-# LANGUAGE Rank2Types, GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Helium.Syntax.UHA_OneLine where + +import Helium.Utils.OneLiner +import Data.Char +import Helium.Syntax.UHA_Utils (showNameAsOperator) +import Helium.StaticAnalysis.Miscellaneous.TypeConversion +import Helium.Syntax.UHA_Syntax +import Data.List +import Helium.Utils.Utils (internalError, hole) +import Control.Monad.Identity (Identity) +import qualified Control.Monad.Identity + + +encloseSep :: String -> String -> String -> [OneLineTree] -> OneLineTree +encloseSep left _ right [] = OneLineNode [OneLineText left, OneLineText right] +encloseSep left sep right (t:ts) = + OneLineNode ([ OneLineText left] ++ (t : concatMap (\t' -> [OneLineText sep,t']) ts) ++ [OneLineText right] ) + +punctuate :: String -> [OneLineTree] -> OneLineTree +punctuate _ [] = OneLineText "" +punctuate _ [t] = t +punctuate s (t:ts) = OneLineNode (t : concatMap (\t' -> [OneLineText s,t']) ts) + +parens :: OneLineTree -> OneLineTree +parens tree = OneLineNode [ OneLineText "(", tree, OneLineText ")" ] + +sepBy :: OneLineTree -> [OneLineTree] -> [OneLineTree] +sepBy separator list = + intersperse separator (map (\x -> OneLineNode [x]) list) + +intErr :: String -> String -> a +intErr node message = internalError "UHA_OneLine" node message + +oneLineTreeAsOperator :: OneLineTree -> OneLineTree +oneLineTreeAsOperator tree = + case tree of + OneLineNode [OneLineText (first:_)] + | isAlpha first || first == '_' + -> OneLineNode [ OneLineText "`", tree, OneLineText "`" ] + _ -> tree +-- Alternative ------------------------------------------------- +-- wrapper +data Inh_Alternative = Inh_Alternative { } +data Syn_Alternative = Syn_Alternative { oneLineTree_Syn_Alternative :: (OneLineTree), self_Syn_Alternative :: (Alternative) } +{-# INLINABLE wrap_Alternative #-} +wrap_Alternative :: T_Alternative -> Inh_Alternative -> (Syn_Alternative ) +wrap_Alternative (T_Alternative act) (Inh_Alternative ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternative_vIn1 + (T_Alternative_vOut1 _lhsOoneLineTree _lhsOself) <- return (inv_Alternative_s2 sem arg) + return (Syn_Alternative _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternative #-} +sem_Alternative :: Alternative -> T_Alternative +sem_Alternative ( Alternative_Hole range_ id_ ) = sem_Alternative_Hole ( sem_Range range_ ) id_ +sem_Alternative ( Alternative_Feedback range_ feedback_ alternative_ ) = sem_Alternative_Feedback ( sem_Range range_ ) feedback_ ( sem_Alternative alternative_ ) +sem_Alternative ( Alternative_Alternative range_ pattern_ righthandside_ ) = sem_Alternative_Alternative ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Alternative ( Alternative_Empty range_ ) = sem_Alternative_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Alternative = T_Alternative { + attach_T_Alternative :: Identity (T_Alternative_s2 ) + } +newtype T_Alternative_s2 = C_Alternative_s2 { + inv_Alternative_s2 :: (T_Alternative_v1 ) + } +data T_Alternative_s3 = C_Alternative_s3 +type T_Alternative_v1 = (T_Alternative_vIn1 ) -> (T_Alternative_vOut1 ) +data T_Alternative_vIn1 = T_Alternative_vIn1 +data T_Alternative_vOut1 = T_Alternative_vOut1 (OneLineTree) (Alternative) +{-# NOINLINE sem_Alternative_Hole #-} +sem_Alternative_Hole :: T_Range -> (Integer) -> T_Alternative +sem_Alternative_Hole arg_range_ arg_id_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule0 () + _self = rule1 _rangeIself arg_id_ + _lhsOself :: Alternative + _lhsOself = rule2 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule3 _oneLineTree + __result_ = T_Alternative_vOut1 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule0 #-} + rule0 = \ (_ :: ()) -> + OneLineText hole + {-# INLINE rule1 #-} + rule1 = \ ((_rangeIself) :: Range) id_ -> + Alternative_Hole _rangeIself id_ + {-# INLINE rule2 #-} + rule2 = \ _self -> + _self + {-# INLINE rule3 #-} + rule3 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Alternative_Feedback #-} +sem_Alternative_Feedback :: T_Range -> (String) -> T_Alternative -> T_Alternative +sem_Alternative_Feedback arg_range_ arg_feedback_ arg_alternative_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _alternativeX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_alternative_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Alternative_vOut1 _alternativeIoneLineTree _alternativeIself) = inv_Alternative_s2 _alternativeX2 (T_Alternative_vIn1 ) + _self = rule4 _alternativeIself _rangeIself arg_feedback_ + _lhsOself :: Alternative + _lhsOself = rule5 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule6 _alternativeIoneLineTree + __result_ = T_Alternative_vOut1 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule4 #-} + rule4 = \ ((_alternativeIself) :: Alternative) ((_rangeIself) :: Range) feedback_ -> + Alternative_Feedback _rangeIself feedback_ _alternativeIself + {-# INLINE rule5 #-} + rule5 = \ _self -> + _self + {-# INLINE rule6 #-} + rule6 = \ ((_alternativeIoneLineTree) :: OneLineTree) -> + _alternativeIoneLineTree +{-# NOINLINE sem_Alternative_Alternative #-} +sem_Alternative_Alternative :: T_Range -> T_Pattern -> T_RightHandSide -> T_Alternative +sem_Alternative_Alternative arg_range_ arg_pattern_ arg_righthandside_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIoneLineTree _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_RightHandSide_vOut148 _righthandsideIoneLineTree _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 ) + _oneLineTree = rule7 _patternIoneLineTree _righthandsideIoneLineTree + _self = rule8 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Alternative + _lhsOself = rule9 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule10 _oneLineTree + __result_ = T_Alternative_vOut1 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule7 #-} + rule7 = \ ((_patternIoneLineTree) :: OneLineTree) ((_righthandsideIoneLineTree) :: String -> OneLineTree ) -> + OneLineNode [ _patternIoneLineTree, _righthandsideIoneLineTree " -> " ] + {-# INLINE rule8 #-} + rule8 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Alternative_Alternative _rangeIself _patternIself _righthandsideIself + {-# INLINE rule9 #-} + rule9 = \ _self -> + _self + {-# INLINE rule10 #-} + rule10 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Alternative_Empty #-} +sem_Alternative_Empty :: T_Range -> T_Alternative +sem_Alternative_Empty arg_range_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule11 () + _self = rule12 _rangeIself + _lhsOself :: Alternative + _lhsOself = rule13 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule14 _oneLineTree + __result_ = T_Alternative_vOut1 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule11 #-} + rule11 = \ (_ :: ()) -> + OneLineText "" + {-# INLINE rule12 #-} + rule12 = \ ((_rangeIself) :: Range) -> + Alternative_Empty _rangeIself + {-# INLINE rule13 #-} + rule13 = \ _self -> + _self + {-# INLINE rule14 #-} + rule14 = \ _oneLineTree -> + _oneLineTree + +-- Alternatives ------------------------------------------------ +-- wrapper +data Inh_Alternatives = Inh_Alternatives { } +data Syn_Alternatives = Syn_Alternatives { oneLineTree_Syn_Alternatives :: ( [ OneLineTree] ), self_Syn_Alternatives :: (Alternatives) } +{-# INLINABLE wrap_Alternatives #-} +wrap_Alternatives :: T_Alternatives -> Inh_Alternatives -> (Syn_Alternatives ) +wrap_Alternatives (T_Alternatives act) (Inh_Alternatives ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternatives_vIn4 + (T_Alternatives_vOut4 _lhsOoneLineTree _lhsOself) <- return (inv_Alternatives_s5 sem arg) + return (Syn_Alternatives _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Alternatives #-} +sem_Alternatives :: Alternatives -> T_Alternatives +sem_Alternatives list = Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) + +-- semantic domain +newtype T_Alternatives = T_Alternatives { + attach_T_Alternatives :: Identity (T_Alternatives_s5 ) + } +newtype T_Alternatives_s5 = C_Alternatives_s5 { + inv_Alternatives_s5 :: (T_Alternatives_v4 ) + } +data T_Alternatives_s6 = C_Alternatives_s6 +type T_Alternatives_v4 = (T_Alternatives_vIn4 ) -> (T_Alternatives_vOut4 ) +data T_Alternatives_vIn4 = T_Alternatives_vIn4 +data T_Alternatives_vOut4 = T_Alternatives_vOut4 ( [ OneLineTree] ) (Alternatives) +{-# NOINLINE sem_Alternatives_Cons #-} +sem_Alternatives_Cons :: T_Alternative -> T_Alternatives -> T_Alternatives +sem_Alternatives_Cons arg_hd_ arg_tl_ = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 ) -> ( let + _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_hd_)) + _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_tl_)) + (T_Alternative_vOut1 _hdIoneLineTree _hdIself) = inv_Alternative_s2 _hdX2 (T_Alternative_vIn1 ) + (T_Alternatives_vOut4 _tlIoneLineTree _tlIself) = inv_Alternatives_s5 _tlX5 (T_Alternatives_vIn4 ) + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule15 _hdIoneLineTree _tlIoneLineTree + _self = rule16 _hdIself _tlIself + _lhsOself :: Alternatives + _lhsOself = rule17 _self + __result_ = T_Alternatives_vOut4 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule15 #-} + rule15 = \ ((_hdIoneLineTree) :: OneLineTree) ((_tlIoneLineTree) :: [ OneLineTree] ) -> + _hdIoneLineTree : _tlIoneLineTree + {-# INLINE rule16 #-} + rule16 = \ ((_hdIself) :: Alternative) ((_tlIself) :: Alternatives) -> + (:) _hdIself _tlIself + {-# INLINE rule17 #-} + rule17 = \ _self -> + _self +{-# NOINLINE sem_Alternatives_Nil #-} +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 ) -> ( let + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule18 () + _self = rule19 () + _lhsOself :: Alternatives + _lhsOself = rule20 _self + __result_ = T_Alternatives_vOut4 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule18 #-} + rule18 = \ (_ :: ()) -> + [] + {-# INLINE rule19 #-} + rule19 = \ (_ :: ()) -> + [] + {-# INLINE rule20 #-} + rule20 = \ _self -> + _self + +-- AnnotatedType ----------------------------------------------- +-- wrapper +data Inh_AnnotatedType = Inh_AnnotatedType { } +data Syn_AnnotatedType = Syn_AnnotatedType { self_Syn_AnnotatedType :: (AnnotatedType) } +{-# INLINABLE wrap_AnnotatedType #-} +wrap_AnnotatedType :: T_AnnotatedType -> Inh_AnnotatedType -> (Syn_AnnotatedType ) +wrap_AnnotatedType (T_AnnotatedType act) (Inh_AnnotatedType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedType_vIn7 + (T_AnnotatedType_vOut7 _lhsOself) <- return (inv_AnnotatedType_s8 sem arg) + return (Syn_AnnotatedType _lhsOself) + ) + +-- cata +{-# INLINE sem_AnnotatedType #-} +sem_AnnotatedType :: AnnotatedType -> T_AnnotatedType +sem_AnnotatedType ( AnnotatedType_AnnotatedType range_ strict_ type_ ) = sem_AnnotatedType_AnnotatedType ( sem_Range range_ ) strict_ ( sem_Type type_ ) + +-- semantic domain +newtype T_AnnotatedType = T_AnnotatedType { + attach_T_AnnotatedType :: Identity (T_AnnotatedType_s8 ) + } +newtype T_AnnotatedType_s8 = C_AnnotatedType_s8 { + inv_AnnotatedType_s8 :: (T_AnnotatedType_v7 ) + } +data T_AnnotatedType_s9 = C_AnnotatedType_s9 +type T_AnnotatedType_v7 = (T_AnnotatedType_vIn7 ) -> (T_AnnotatedType_vOut7 ) +data T_AnnotatedType_vIn7 = T_AnnotatedType_vIn7 +data T_AnnotatedType_vOut7 = T_AnnotatedType_vOut7 (AnnotatedType) +{-# NOINLINE sem_AnnotatedType_AnnotatedType #-} +sem_AnnotatedType_AnnotatedType :: T_Range -> (Bool) -> T_Type -> T_AnnotatedType +sem_AnnotatedType_AnnotatedType arg_range_ arg_strict_ arg_type_ = T_AnnotatedType (return st8) where + {-# NOINLINE st8 #-} + st8 = let + v7 :: T_AnnotatedType_v7 + v7 = \ (T_AnnotatedType_vIn7 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule21 _rangeIself _typeIself arg_strict_ + _lhsOself :: AnnotatedType + _lhsOself = rule22 _self + __result_ = T_AnnotatedType_vOut7 _lhsOself + in __result_ ) + in C_AnnotatedType_s8 v7 + {-# INLINE rule21 #-} + rule21 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) strict_ -> + AnnotatedType_AnnotatedType _rangeIself strict_ _typeIself + {-# INLINE rule22 #-} + rule22 = \ _self -> + _self + +-- AnnotatedTypes ---------------------------------------------- +-- wrapper +data Inh_AnnotatedTypes = Inh_AnnotatedTypes { } +data Syn_AnnotatedTypes = Syn_AnnotatedTypes { self_Syn_AnnotatedTypes :: (AnnotatedTypes) } +{-# INLINABLE wrap_AnnotatedTypes #-} +wrap_AnnotatedTypes :: T_AnnotatedTypes -> Inh_AnnotatedTypes -> (Syn_AnnotatedTypes ) +wrap_AnnotatedTypes (T_AnnotatedTypes act) (Inh_AnnotatedTypes ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedTypes_vIn10 + (T_AnnotatedTypes_vOut10 _lhsOself) <- return (inv_AnnotatedTypes_s11 sem arg) + return (Syn_AnnotatedTypes _lhsOself) + ) + +-- cata +{-# NOINLINE sem_AnnotatedTypes #-} +sem_AnnotatedTypes :: AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes list = Prelude.foldr sem_AnnotatedTypes_Cons sem_AnnotatedTypes_Nil (Prelude.map sem_AnnotatedType list) + +-- semantic domain +newtype T_AnnotatedTypes = T_AnnotatedTypes { + attach_T_AnnotatedTypes :: Identity (T_AnnotatedTypes_s11 ) + } +newtype T_AnnotatedTypes_s11 = C_AnnotatedTypes_s11 { + inv_AnnotatedTypes_s11 :: (T_AnnotatedTypes_v10 ) + } +data T_AnnotatedTypes_s12 = C_AnnotatedTypes_s12 +type T_AnnotatedTypes_v10 = (T_AnnotatedTypes_vIn10 ) -> (T_AnnotatedTypes_vOut10 ) +data T_AnnotatedTypes_vIn10 = T_AnnotatedTypes_vIn10 +data T_AnnotatedTypes_vOut10 = T_AnnotatedTypes_vOut10 (AnnotatedTypes) +{-# NOINLINE sem_AnnotatedTypes_Cons #-} +sem_AnnotatedTypes_Cons :: T_AnnotatedType -> T_AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes_Cons arg_hd_ arg_tl_ = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _hdX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_hd_)) + _tlX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_tl_)) + (T_AnnotatedType_vOut7 _hdIself) = inv_AnnotatedType_s8 _hdX8 (T_AnnotatedType_vIn7 ) + (T_AnnotatedTypes_vOut10 _tlIself) = inv_AnnotatedTypes_s11 _tlX11 (T_AnnotatedTypes_vIn10 ) + _self = rule23 _hdIself _tlIself + _lhsOself :: AnnotatedTypes + _lhsOself = rule24 _self + __result_ = T_AnnotatedTypes_vOut10 _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule23 #-} + rule23 = \ ((_hdIself) :: AnnotatedType) ((_tlIself) :: AnnotatedTypes) -> + (:) _hdIself _tlIself + {-# INLINE rule24 #-} + rule24 = \ _self -> + _self +{-# NOINLINE sem_AnnotatedTypes_Nil #-} +sem_AnnotatedTypes_Nil :: T_AnnotatedTypes +sem_AnnotatedTypes_Nil = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _self = rule25 () + _lhsOself :: AnnotatedTypes + _lhsOself = rule26 _self + __result_ = T_AnnotatedTypes_vOut10 _lhsOself + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule25 #-} + rule25 = \ (_ :: ()) -> + [] + {-# INLINE rule26 #-} + rule26 = \ _self -> + _self + +-- Body -------------------------------------------------------- +-- wrapper +data Inh_Body = Inh_Body { } +data Syn_Body = Syn_Body { self_Syn_Body :: (Body) } +{-# INLINABLE wrap_Body #-} +wrap_Body :: T_Body -> Inh_Body -> (Syn_Body ) +wrap_Body (T_Body act) (Inh_Body ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Body_vIn13 + (T_Body_vOut13 _lhsOself) <- return (inv_Body_s14 sem arg) + return (Syn_Body _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Body #-} +sem_Body :: Body -> T_Body +sem_Body ( Body_Hole range_ id_ ) = sem_Body_Hole ( sem_Range range_ ) id_ +sem_Body ( Body_Body range_ importdeclarations_ declarations_ ) = sem_Body_Body ( sem_Range range_ ) ( sem_ImportDeclarations importdeclarations_ ) ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_Body = T_Body { + attach_T_Body :: Identity (T_Body_s14 ) + } +newtype T_Body_s14 = C_Body_s14 { + inv_Body_s14 :: (T_Body_v13 ) + } +data T_Body_s15 = C_Body_s15 +type T_Body_v13 = (T_Body_vIn13 ) -> (T_Body_vOut13 ) +data T_Body_vIn13 = T_Body_vIn13 +data T_Body_vOut13 = T_Body_vOut13 (Body) +{-# NOINLINE sem_Body_Hole #-} +sem_Body_Hole :: T_Range -> (Integer) -> T_Body +sem_Body_Hole arg_range_ arg_id_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule27 _rangeIself arg_id_ + _lhsOself :: Body + _lhsOself = rule28 _self + __result_ = T_Body_vOut13 _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule27 #-} + rule27 = \ ((_rangeIself) :: Range) id_ -> + Body_Hole _rangeIself id_ + {-# INLINE rule28 #-} + rule28 = \ _self -> + _self +{-# NOINLINE sem_Body_Body #-} +sem_Body_Body :: T_Range -> T_ImportDeclarations -> T_Declarations -> T_Body +sem_Body_Body arg_range_ arg_importdeclarations_ arg_declarations_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importdeclarationsX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_importdeclarations_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ImportDeclarations_vOut73 _importdeclarationsIself) = inv_ImportDeclarations_s74 _importdeclarationsX74 (T_ImportDeclarations_vIn73 ) + (T_Declarations_vOut31 _declarationsIoneLineTree _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _self = rule29 _declarationsIself _importdeclarationsIself _rangeIself + _lhsOself :: Body + _lhsOself = rule30 _self + __result_ = T_Body_vOut13 _lhsOself + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule29 #-} + rule29 = \ ((_declarationsIself) :: Declarations) ((_importdeclarationsIself) :: ImportDeclarations) ((_rangeIself) :: Range) -> + Body_Body _rangeIself _importdeclarationsIself _declarationsIself + {-# INLINE rule30 #-} + rule30 = \ _self -> + _self + +-- Constructor ------------------------------------------------- +-- wrapper +data Inh_Constructor = Inh_Constructor { } +data Syn_Constructor = Syn_Constructor { self_Syn_Constructor :: (Constructor) } +{-# INLINABLE wrap_Constructor #-} +wrap_Constructor :: T_Constructor -> Inh_Constructor -> (Syn_Constructor ) +wrap_Constructor (T_Constructor act) (Inh_Constructor ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructor_vIn16 + (T_Constructor_vOut16 _lhsOself) <- return (inv_Constructor_s17 sem arg) + return (Syn_Constructor _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructor #-} +sem_Constructor :: Constructor -> T_Constructor +sem_Constructor ( Constructor_Constructor range_ constructor_ types_ ) = sem_Constructor_Constructor ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_AnnotatedTypes types_ ) +sem_Constructor ( Constructor_Infix range_ leftType_ constructorOperator_ rightType_ ) = sem_Constructor_Infix ( sem_Range range_ ) ( sem_AnnotatedType leftType_ ) ( sem_Name constructorOperator_ ) ( sem_AnnotatedType rightType_ ) +sem_Constructor ( Constructor_Record range_ constructor_ fieldDeclarations_ ) = sem_Constructor_Record ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_FieldDeclarations fieldDeclarations_ ) + +-- semantic domain +newtype T_Constructor = T_Constructor { + attach_T_Constructor :: Identity (T_Constructor_s17 ) + } +newtype T_Constructor_s17 = C_Constructor_s17 { + inv_Constructor_s17 :: (T_Constructor_v16 ) + } +data T_Constructor_s18 = C_Constructor_s18 +type T_Constructor_v16 = (T_Constructor_vIn16 ) -> (T_Constructor_vOut16 ) +data T_Constructor_vIn16 = T_Constructor_vIn16 +data T_Constructor_vOut16 = T_Constructor_vOut16 (Constructor) +{-# NOINLINE sem_Constructor_Constructor #-} +sem_Constructor_Constructor :: T_Range -> T_Name -> T_AnnotatedTypes -> T_Constructor +sem_Constructor_Constructor arg_range_ arg_constructor_ arg_types_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _typesX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIisIdentifier _constructorIisOperator _constructorIisSpecial _constructorIoneLineTree _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_AnnotatedTypes_vOut10 _typesIself) = inv_AnnotatedTypes_s11 _typesX11 (T_AnnotatedTypes_vIn10 ) + _self = rule31 _constructorIself _rangeIself _typesIself + _lhsOself :: Constructor + _lhsOself = rule32 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule31 #-} + rule31 = \ ((_constructorIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: AnnotatedTypes) -> + Constructor_Constructor _rangeIself _constructorIself _typesIself + {-# INLINE rule32 #-} + rule32 = \ _self -> + _self +{-# NOINLINE sem_Constructor_Infix #-} +sem_Constructor_Infix :: T_Range -> T_AnnotatedType -> T_Name -> T_AnnotatedType -> T_Constructor +sem_Constructor_Infix arg_range_ arg_leftType_ arg_constructorOperator_ arg_rightType_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_leftType_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_rightType_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_AnnotatedType_vOut7 _leftTypeIself) = inv_AnnotatedType_s8 _leftTypeX8 (T_AnnotatedType_vIn7 ) + (T_Name_vOut112 _constructorOperatorIisIdentifier _constructorOperatorIisOperator _constructorOperatorIisSpecial _constructorOperatorIoneLineTree _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_AnnotatedType_vOut7 _rightTypeIself) = inv_AnnotatedType_s8 _rightTypeX8 (T_AnnotatedType_vIn7 ) + _self = rule33 _constructorOperatorIself _leftTypeIself _rangeIself _rightTypeIself + _lhsOself :: Constructor + _lhsOself = rule34 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule33 #-} + rule33 = \ ((_constructorOperatorIself) :: Name) ((_leftTypeIself) :: AnnotatedType) ((_rangeIself) :: Range) ((_rightTypeIself) :: AnnotatedType) -> + Constructor_Infix _rangeIself _leftTypeIself _constructorOperatorIself _rightTypeIself + {-# INLINE rule34 #-} + rule34 = \ _self -> + _self +{-# NOINLINE sem_Constructor_Record #-} +sem_Constructor_Record :: T_Range -> T_Name -> T_FieldDeclarations -> T_Constructor +sem_Constructor_Record arg_range_ arg_constructor_ arg_fieldDeclarations_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _fieldDeclarationsX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_fieldDeclarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIisIdentifier _constructorIisOperator _constructorIisSpecial _constructorIoneLineTree _constructorIself) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_FieldDeclarations_vOut49 _fieldDeclarationsIself) = inv_FieldDeclarations_s50 _fieldDeclarationsX50 (T_FieldDeclarations_vIn49 ) + _self = rule35 _constructorIself _fieldDeclarationsIself _rangeIself + _lhsOself :: Constructor + _lhsOself = rule36 _self + __result_ = T_Constructor_vOut16 _lhsOself + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule35 #-} + rule35 = \ ((_constructorIself) :: Name) ((_fieldDeclarationsIself) :: FieldDeclarations) ((_rangeIself) :: Range) -> + Constructor_Record _rangeIself _constructorIself _fieldDeclarationsIself + {-# INLINE rule36 #-} + rule36 = \ _self -> + _self + +-- Constructors ------------------------------------------------ +-- wrapper +data Inh_Constructors = Inh_Constructors { } +data Syn_Constructors = Syn_Constructors { self_Syn_Constructors :: (Constructors) } +{-# INLINABLE wrap_Constructors #-} +wrap_Constructors :: T_Constructors -> Inh_Constructors -> (Syn_Constructors ) +wrap_Constructors (T_Constructors act) (Inh_Constructors ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructors_vIn19 + (T_Constructors_vOut19 _lhsOself) <- return (inv_Constructors_s20 sem arg) + return (Syn_Constructors _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Constructors #-} +sem_Constructors :: Constructors -> T_Constructors +sem_Constructors list = Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list) + +-- semantic domain +newtype T_Constructors = T_Constructors { + attach_T_Constructors :: Identity (T_Constructors_s20 ) + } +newtype T_Constructors_s20 = C_Constructors_s20 { + inv_Constructors_s20 :: (T_Constructors_v19 ) + } +data T_Constructors_s21 = C_Constructors_s21 +type T_Constructors_v19 = (T_Constructors_vIn19 ) -> (T_Constructors_vOut19 ) +data T_Constructors_vIn19 = T_Constructors_vIn19 +data T_Constructors_vOut19 = T_Constructors_vOut19 (Constructors) +{-# NOINLINE sem_Constructors_Cons #-} +sem_Constructors_Cons :: T_Constructor -> T_Constructors -> T_Constructors +sem_Constructors_Cons arg_hd_ arg_tl_ = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 ) -> ( let + _hdX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_hd_)) + _tlX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_tl_)) + (T_Constructor_vOut16 _hdIself) = inv_Constructor_s17 _hdX17 (T_Constructor_vIn16 ) + (T_Constructors_vOut19 _tlIself) = inv_Constructors_s20 _tlX20 (T_Constructors_vIn19 ) + _self = rule37 _hdIself _tlIself + _lhsOself :: Constructors + _lhsOself = rule38 _self + __result_ = T_Constructors_vOut19 _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule37 #-} + rule37 = \ ((_hdIself) :: Constructor) ((_tlIself) :: Constructors) -> + (:) _hdIself _tlIself + {-# INLINE rule38 #-} + rule38 = \ _self -> + _self +{-# NOINLINE sem_Constructors_Nil #-} +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 ) -> ( let + _self = rule39 () + _lhsOself :: Constructors + _lhsOself = rule40 _self + __result_ = T_Constructors_vOut19 _lhsOself + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule39 #-} + rule39 = \ (_ :: ()) -> + [] + {-# INLINE rule40 #-} + rule40 = \ _self -> + _self + +-- ContextItem ------------------------------------------------- +-- wrapper +data Inh_ContextItem = Inh_ContextItem { } +data Syn_ContextItem = Syn_ContextItem { self_Syn_ContextItem :: (ContextItem) } +{-# INLINABLE wrap_ContextItem #-} +wrap_ContextItem :: T_ContextItem -> Inh_ContextItem -> (Syn_ContextItem ) +wrap_ContextItem (T_ContextItem act) (Inh_ContextItem ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItem_vIn22 + (T_ContextItem_vOut22 _lhsOself) <- return (inv_ContextItem_s23 sem arg) + return (Syn_ContextItem _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItem #-} +sem_ContextItem :: ContextItem -> T_ContextItem +sem_ContextItem ( ContextItem_ContextItem range_ name_ types_ ) = sem_ContextItem_ContextItem ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Types types_ ) + +-- semantic domain +newtype T_ContextItem = T_ContextItem { + attach_T_ContextItem :: Identity (T_ContextItem_s23 ) + } +newtype T_ContextItem_s23 = C_ContextItem_s23 { + inv_ContextItem_s23 :: (T_ContextItem_v22 ) + } +data T_ContextItem_s24 = C_ContextItem_s24 +type T_ContextItem_v22 = (T_ContextItem_vIn22 ) -> (T_ContextItem_vOut22 ) +data T_ContextItem_vIn22 = T_ContextItem_vIn22 +data T_ContextItem_vOut22 = T_ContextItem_vOut22 (ContextItem) +{-# NOINLINE sem_ContextItem_ContextItem #-} +sem_ContextItem_ContextItem :: T_Range -> T_Name -> T_Types -> T_ContextItem +sem_ContextItem_ContextItem arg_range_ arg_name_ arg_types_ = T_ContextItem (return st23) where + {-# NOINLINE st23 #-} + st23 = let + v22 :: T_ContextItem_v22 + v22 = \ (T_ContextItem_vIn22 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _self = rule41 _nameIself _rangeIself _typesIself + _lhsOself :: ContextItem + _lhsOself = rule42 _self + __result_ = T_ContextItem_vOut22 _lhsOself + in __result_ ) + in C_ContextItem_s23 v22 + {-# INLINE rule41 #-} + rule41 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + ContextItem_ContextItem _rangeIself _nameIself _typesIself + {-# INLINE rule42 #-} + rule42 = \ _self -> + _self + +-- ContextItems ------------------------------------------------ +-- wrapper +data Inh_ContextItems = Inh_ContextItems { } +data Syn_ContextItems = Syn_ContextItems { self_Syn_ContextItems :: (ContextItems) } +{-# INLINABLE wrap_ContextItems #-} +wrap_ContextItems :: T_ContextItems -> Inh_ContextItems -> (Syn_ContextItems ) +wrap_ContextItems (T_ContextItems act) (Inh_ContextItems ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItems_vIn25 + (T_ContextItems_vOut25 _lhsOself) <- return (inv_ContextItems_s26 sem arg) + return (Syn_ContextItems _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ContextItems #-} +sem_ContextItems :: ContextItems -> T_ContextItems +sem_ContextItems list = Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list) + +-- semantic domain +newtype T_ContextItems = T_ContextItems { + attach_T_ContextItems :: Identity (T_ContextItems_s26 ) + } +newtype T_ContextItems_s26 = C_ContextItems_s26 { + inv_ContextItems_s26 :: (T_ContextItems_v25 ) + } +data T_ContextItems_s27 = C_ContextItems_s27 +type T_ContextItems_v25 = (T_ContextItems_vIn25 ) -> (T_ContextItems_vOut25 ) +data T_ContextItems_vIn25 = T_ContextItems_vIn25 +data T_ContextItems_vOut25 = T_ContextItems_vOut25 (ContextItems) +{-# NOINLINE sem_ContextItems_Cons #-} +sem_ContextItems_Cons :: T_ContextItem -> T_ContextItems -> T_ContextItems +sem_ContextItems_Cons arg_hd_ arg_tl_ = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _hdX23 = Control.Monad.Identity.runIdentity (attach_T_ContextItem (arg_hd_)) + _tlX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_tl_)) + (T_ContextItem_vOut22 _hdIself) = inv_ContextItem_s23 _hdX23 (T_ContextItem_vIn22 ) + (T_ContextItems_vOut25 _tlIself) = inv_ContextItems_s26 _tlX26 (T_ContextItems_vIn25 ) + _self = rule43 _hdIself _tlIself + _lhsOself :: ContextItems + _lhsOself = rule44 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule43 #-} + rule43 = \ ((_hdIself) :: ContextItem) ((_tlIself) :: ContextItems) -> + (:) _hdIself _tlIself + {-# INLINE rule44 #-} + rule44 = \ _self -> + _self +{-# NOINLINE sem_ContextItems_Nil #-} +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _self = rule45 () + _lhsOself :: ContextItems + _lhsOself = rule46 _self + __result_ = T_ContextItems_vOut25 _lhsOself + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule45 #-} + rule45 = \ (_ :: ()) -> + [] + {-# INLINE rule46 #-} + rule46 = \ _self -> + _self + +-- Declaration ------------------------------------------------- +-- wrapper +data Inh_Declaration = Inh_Declaration { } +data Syn_Declaration = Syn_Declaration { oneLineTree_Syn_Declaration :: (OneLineTree), self_Syn_Declaration :: (Declaration) } +{-# INLINABLE wrap_Declaration #-} +wrap_Declaration :: T_Declaration -> Inh_Declaration -> (Syn_Declaration ) +wrap_Declaration (T_Declaration act) (Inh_Declaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declaration_vIn28 + (T_Declaration_vOut28 _lhsOoneLineTree _lhsOself) <- return (inv_Declaration_s29 sem arg) + return (Syn_Declaration _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declaration #-} +sem_Declaration :: Declaration -> T_Declaration +sem_Declaration ( Declaration_Hole range_ id_ ) = sem_Declaration_Hole ( sem_Range range_ ) id_ +sem_Declaration ( Declaration_Type range_ simpletype_ type_ ) = sem_Declaration_Type ( sem_Range range_ ) ( sem_SimpleType simpletype_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Data range_ context_ simpletype_ constructors_ derivings_ ) = sem_Declaration_Data ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructors constructors_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Newtype range_ context_ simpletype_ constructor_ derivings_ ) = sem_Declaration_Newtype ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructor constructor_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Class range_ context_ simpletype_ where_ ) = sem_Declaration_Class ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Instance range_ context_ name_ types_ where_ ) = sem_Declaration_Instance ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Name name_ ) ( sem_Types types_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Default range_ types_ ) = sem_Declaration_Default ( sem_Range range_ ) ( sem_Types types_ ) +sem_Declaration ( Declaration_FunctionBindings range_ bindings_ ) = sem_Declaration_FunctionBindings ( sem_Range range_ ) ( sem_FunctionBindings bindings_ ) +sem_Declaration ( Declaration_PatternBinding range_ pattern_ righthandside_ ) = sem_Declaration_PatternBinding ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Declaration ( Declaration_TypeSignature range_ names_ type_ ) = sem_Declaration_TypeSignature ( sem_Range range_ ) ( sem_Names names_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Fixity range_ fixity_ priority_ operators_ ) = sem_Declaration_Fixity ( sem_Range range_ ) ( sem_Fixity fixity_ ) ( sem_MaybeInt priority_ ) ( sem_Names operators_ ) +sem_Declaration ( Declaration_Empty range_ ) = sem_Declaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Declaration = T_Declaration { + attach_T_Declaration :: Identity (T_Declaration_s29 ) + } +newtype T_Declaration_s29 = C_Declaration_s29 { + inv_Declaration_s29 :: (T_Declaration_v28 ) + } +data T_Declaration_s30 = C_Declaration_s30 +type T_Declaration_v28 = (T_Declaration_vIn28 ) -> (T_Declaration_vOut28 ) +data T_Declaration_vIn28 = T_Declaration_vIn28 +data T_Declaration_vOut28 = T_Declaration_vOut28 (OneLineTree) (Declaration) +{-# NOINLINE sem_Declaration_Hole #-} +sem_Declaration_Hole :: T_Range -> (Integer) -> T_Declaration +sem_Declaration_Hole arg_range_ arg_id_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule47 () + _self = rule48 _rangeIself arg_id_ + _lhsOself :: Declaration + _lhsOself = rule49 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule50 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule47 #-} + rule47 = \ (_ :: ()) -> + OneLineText hole + {-# INLINE rule48 #-} + rule48 = \ ((_rangeIself) :: Range) id_ -> + Declaration_Hole _rangeIself id_ + {-# INLINE rule49 #-} + rule49 = \ _self -> + _self + {-# INLINE rule50 #-} + rule50 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Declaration_Type #-} +sem_Declaration_Type :: T_Range -> T_SimpleType -> T_Type -> T_Declaration +sem_Declaration_Type arg_range_ arg_simpletype_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _oneLineTree = rule51 () + _self = rule52 _rangeIself _simpletypeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule53 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule54 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule51 #-} + rule51 = \ (_ :: ()) -> + intErr "Declaration" "type" + {-# INLINE rule52 #-} + rule52 = \ ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_typeIself) :: Type) -> + Declaration_Type _rangeIself _simpletypeIself _typeIself + {-# INLINE rule53 #-} + rule53 = \ _self -> + _self + {-# INLINE rule54 #-} + rule54 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Declaration_Data #-} +sem_Declaration_Data :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructors -> T_Names -> T_Declaration +sem_Declaration_Data arg_range_ arg_context_ arg_simpletype_ arg_constructors_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorsX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_constructors_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructors_vOut19 _constructorsIself) = inv_Constructors_s20 _constructorsX20 (T_Constructors_vIn19 ) + (T_Names_vOut115 _derivingsIisIdentifier _derivingsIisOperator _derivingsIisSpecial _derivingsIoneLineTree _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _oneLineTree = rule55 () + _self = rule56 _constructorsIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule57 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule58 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule55 #-} + rule55 = \ (_ :: ()) -> + intErr "Declaration" "data" + {-# INLINE rule56 #-} + rule56 = \ ((_constructorsIself) :: Constructors) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Data _rangeIself _contextIself _simpletypeIself _constructorsIself _derivingsIself + {-# INLINE rule57 #-} + rule57 = \ _self -> + _self + {-# INLINE rule58 #-} + rule58 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Declaration_Newtype #-} +sem_Declaration_Newtype :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructor -> T_Names -> T_Declaration +sem_Declaration_Newtype arg_range_ arg_context_ arg_simpletype_ arg_constructor_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_constructor_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructor_vOut16 _constructorIself) = inv_Constructor_s17 _constructorX17 (T_Constructor_vIn16 ) + (T_Names_vOut115 _derivingsIisIdentifier _derivingsIisOperator _derivingsIisSpecial _derivingsIoneLineTree _derivingsIself) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _oneLineTree = rule59 () + _self = rule60 _constructorIself _contextIself _derivingsIself _rangeIself _simpletypeIself + _lhsOself :: Declaration + _lhsOself = rule61 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule62 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule59 #-} + rule59 = \ (_ :: ()) -> + intErr "Declaration" "newtype" + {-# INLINE rule60 #-} + rule60 = \ ((_constructorIself) :: Constructor) ((_contextIself) :: ContextItems) ((_derivingsIself) :: Names) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) -> + Declaration_Newtype _rangeIself _contextIself _simpletypeIself _constructorIself _derivingsIself + {-# INLINE rule61 #-} + rule61 = \ _self -> + _self + {-# INLINE rule62 #-} + rule62 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Declaration_Class #-} +sem_Declaration_Class :: T_Range -> T_ContextItems -> T_SimpleType -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Class arg_range_ arg_context_ arg_simpletype_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeIself) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_MaybeDeclarations_vOut88 _whereIoneLineTree _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _oneLineTree = rule63 () + _self = rule64 _contextIself _rangeIself _simpletypeIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule65 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule66 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule63 #-} + rule63 = \ (_ :: ()) -> + intErr "Declaration" "class" + {-# INLINE rule64 #-} + rule64 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_simpletypeIself) :: SimpleType) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Class _rangeIself _contextIself _simpletypeIself _whereIself + {-# INLINE rule65 #-} + rule65 = \ _self -> + _self + {-# INLINE rule66 #-} + rule66 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Declaration_Instance #-} +sem_Declaration_Instance :: T_Range -> T_ContextItems -> T_Name -> T_Types -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Instance arg_range_ arg_context_ arg_name_ arg_types_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + (T_MaybeDeclarations_vOut88 _whereIoneLineTree _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _oneLineTree = rule67 () + _self = rule68 _contextIself _nameIself _rangeIself _typesIself _whereIself + _lhsOself :: Declaration + _lhsOself = rule69 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule70 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule67 #-} + rule67 = \ (_ :: ()) -> + intErr "Declaration" "instance" + {-# INLINE rule68 #-} + rule68 = \ ((_contextIself) :: ContextItems) ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typesIself) :: Types) ((_whereIself) :: MaybeDeclarations) -> + Declaration_Instance _rangeIself _contextIself _nameIself _typesIself _whereIself + {-# INLINE rule69 #-} + rule69 = \ _self -> + _self + {-# INLINE rule70 #-} + rule70 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Declaration_Default #-} +sem_Declaration_Default :: T_Range -> T_Types -> T_Declaration +sem_Declaration_Default arg_range_ arg_types_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Types_vOut166 _typesIself) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _oneLineTree = rule71 () + _self = rule72 _rangeIself _typesIself + _lhsOself :: Declaration + _lhsOself = rule73 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule74 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule71 #-} + rule71 = \ (_ :: ()) -> + intErr "Declaration" "default" + {-# INLINE rule72 #-} + rule72 = \ ((_rangeIself) :: Range) ((_typesIself) :: Types) -> + Declaration_Default _rangeIself _typesIself + {-# INLINE rule73 #-} + rule73 = \ _self -> + _self + {-# INLINE rule74 #-} + rule74 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Declaration_FunctionBindings #-} +sem_Declaration_FunctionBindings :: T_Range -> T_FunctionBindings -> T_Declaration +sem_Declaration_FunctionBindings arg_range_ arg_bindings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _bindingsX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_bindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBindings_vOut58 _bindingsIoneLineTree _bindingsIself) = inv_FunctionBindings_s59 _bindingsX59 (T_FunctionBindings_vIn58 ) + _oneLineTree = rule75 _bindingsIoneLineTree + _self = rule76 _bindingsIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule77 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule78 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule75 #-} + rule75 = \ ((_bindingsIoneLineTree) :: [ OneLineTree] ) -> + punctuate ";" _bindingsIoneLineTree + {-# INLINE rule76 #-} + rule76 = \ ((_bindingsIself) :: FunctionBindings) ((_rangeIself) :: Range) -> + Declaration_FunctionBindings _rangeIself _bindingsIself + {-# INLINE rule77 #-} + rule77 = \ _self -> + _self + {-# INLINE rule78 #-} + rule78 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Declaration_PatternBinding #-} +sem_Declaration_PatternBinding :: T_Range -> T_Pattern -> T_RightHandSide -> T_Declaration +sem_Declaration_PatternBinding arg_range_ arg_pattern_ arg_righthandside_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIoneLineTree _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_RightHandSide_vOut148 _righthandsideIoneLineTree _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 ) + _oneLineTree = rule79 _patternIoneLineTree _righthandsideIoneLineTree + _self = rule80 _patternIself _rangeIself _righthandsideIself + _lhsOself :: Declaration + _lhsOself = rule81 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule82 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule79 #-} + rule79 = \ ((_patternIoneLineTree) :: OneLineTree) ((_righthandsideIoneLineTree) :: String -> OneLineTree ) -> + OneLineNode + [ OneLineNode [_patternIoneLineTree] + , OneLineNode [_righthandsideIoneLineTree " = "] + ] + {-# INLINE rule80 #-} + rule80 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + Declaration_PatternBinding _rangeIself _patternIself _righthandsideIself + {-# INLINE rule81 #-} + rule81 = \ _self -> + _self + {-# INLINE rule82 #-} + rule82 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Declaration_TypeSignature #-} +sem_Declaration_TypeSignature :: T_Range -> T_Names -> T_Type -> T_Declaration +sem_Declaration_TypeSignature arg_range_ arg_names_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIisIdentifier _namesIisOperator _namesIisSpecial _namesIoneLineTree _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _oneLineTree = rule83 _namesIself _typeIself + _self = rule84 _namesIself _rangeIself _typeIself + _lhsOself :: Declaration + _lhsOself = rule85 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule86 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule83 #-} + rule83 = \ ((_namesIself) :: Names) ((_typeIself) :: Type) -> + OneLineNode + [ OneLineText (concat . intersperse "," . map show $ _namesIself) + , OneLineText " :: " + , OneLineText (show (makeTpSchemeFromType _typeIself)) + ] + {-# INLINE rule84 #-} + rule84 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Declaration_TypeSignature _rangeIself _namesIself _typeIself + {-# INLINE rule85 #-} + rule85 = \ _self -> + _self + {-# INLINE rule86 #-} + rule86 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Declaration_Fixity #-} +sem_Declaration_Fixity :: T_Range -> T_Fixity -> T_MaybeInt -> T_Names -> T_Declaration +sem_Declaration_Fixity arg_range_ arg_fixity_ arg_priority_ arg_operators_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fixityX53 = Control.Monad.Identity.runIdentity (attach_T_Fixity (arg_fixity_)) + _priorityX101 = Control.Monad.Identity.runIdentity (attach_T_MaybeInt (arg_priority_)) + _operatorsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_operators_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Fixity_vOut52 _fixityIself) = inv_Fixity_s53 _fixityX53 (T_Fixity_vIn52 ) + (T_MaybeInt_vOut100 _priorityIself) = inv_MaybeInt_s101 _priorityX101 (T_MaybeInt_vIn100 ) + (T_Names_vOut115 _operatorsIisIdentifier _operatorsIisOperator _operatorsIisSpecial _operatorsIoneLineTree _operatorsIself) = inv_Names_s116 _operatorsX116 (T_Names_vIn115 ) + _oneLineTree = rule87 () + _self = rule88 _fixityIself _operatorsIself _priorityIself _rangeIself + _lhsOself :: Declaration + _lhsOself = rule89 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule90 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule87 #-} + rule87 = \ (_ :: ()) -> + intErr "Declaration" "fixity" + {-# INLINE rule88 #-} + rule88 = \ ((_fixityIself) :: Fixity) ((_operatorsIself) :: Names) ((_priorityIself) :: MaybeInt) ((_rangeIself) :: Range) -> + Declaration_Fixity _rangeIself _fixityIself _priorityIself _operatorsIself + {-# INLINE rule89 #-} + rule89 = \ _self -> + _self + {-# INLINE rule90 #-} + rule90 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Declaration_Empty #-} +sem_Declaration_Empty :: T_Range -> T_Declaration +sem_Declaration_Empty arg_range_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule91 () + _self = rule92 _rangeIself + _lhsOself :: Declaration + _lhsOself = rule93 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule94 _oneLineTree + __result_ = T_Declaration_vOut28 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule91 #-} + rule91 = \ (_ :: ()) -> + OneLineText "" + {-# INLINE rule92 #-} + rule92 = \ ((_rangeIself) :: Range) -> + Declaration_Empty _rangeIself + {-# INLINE rule93 #-} + rule93 = \ _self -> + _self + {-# INLINE rule94 #-} + rule94 = \ _oneLineTree -> + _oneLineTree + +-- Declarations ------------------------------------------------ +-- wrapper +data Inh_Declarations = Inh_Declarations { } +data Syn_Declarations = Syn_Declarations { oneLineTree_Syn_Declarations :: ( [ OneLineTree] ), self_Syn_Declarations :: (Declarations) } +{-# INLINABLE wrap_Declarations #-} +wrap_Declarations :: T_Declarations -> Inh_Declarations -> (Syn_Declarations ) +wrap_Declarations (T_Declarations act) (Inh_Declarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declarations_vIn31 + (T_Declarations_vOut31 _lhsOoneLineTree _lhsOself) <- return (inv_Declarations_s32 sem arg) + return (Syn_Declarations _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Declarations #-} +sem_Declarations :: Declarations -> T_Declarations +sem_Declarations list = Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list) + +-- semantic domain +newtype T_Declarations = T_Declarations { + attach_T_Declarations :: Identity (T_Declarations_s32 ) + } +newtype T_Declarations_s32 = C_Declarations_s32 { + inv_Declarations_s32 :: (T_Declarations_v31 ) + } +data T_Declarations_s33 = C_Declarations_s33 +type T_Declarations_v31 = (T_Declarations_vIn31 ) -> (T_Declarations_vOut31 ) +data T_Declarations_vIn31 = T_Declarations_vIn31 +data T_Declarations_vOut31 = T_Declarations_vOut31 ( [ OneLineTree] ) (Declarations) +{-# NOINLINE sem_Declarations_Cons #-} +sem_Declarations_Cons :: T_Declaration -> T_Declarations -> T_Declarations +sem_Declarations_Cons arg_hd_ arg_tl_ = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 ) -> ( let + _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Declaration (arg_hd_)) + _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_tl_)) + (T_Declaration_vOut28 _hdIoneLineTree _hdIself) = inv_Declaration_s29 _hdX29 (T_Declaration_vIn28 ) + (T_Declarations_vOut31 _tlIoneLineTree _tlIself) = inv_Declarations_s32 _tlX32 (T_Declarations_vIn31 ) + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule95 _hdIoneLineTree _tlIoneLineTree + _self = rule96 _hdIself _tlIself + _lhsOself :: Declarations + _lhsOself = rule97 _self + __result_ = T_Declarations_vOut31 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule95 #-} + rule95 = \ ((_hdIoneLineTree) :: OneLineTree) ((_tlIoneLineTree) :: [ OneLineTree] ) -> + _hdIoneLineTree : _tlIoneLineTree + {-# INLINE rule96 #-} + rule96 = \ ((_hdIself) :: Declaration) ((_tlIself) :: Declarations) -> + (:) _hdIself _tlIself + {-# INLINE rule97 #-} + rule97 = \ _self -> + _self +{-# NOINLINE sem_Declarations_Nil #-} +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 ) -> ( let + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule98 () + _self = rule99 () + _lhsOself :: Declarations + _lhsOself = rule100 _self + __result_ = T_Declarations_vOut31 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule98 #-} + rule98 = \ (_ :: ()) -> + [] + {-# INLINE rule99 #-} + rule99 = \ (_ :: ()) -> + [] + {-# INLINE rule100 #-} + rule100 = \ _self -> + _self + +-- Export ------------------------------------------------------ +-- wrapper +data Inh_Export = Inh_Export { } +data Syn_Export = Syn_Export { self_Syn_Export :: (Export) } +{-# INLINABLE wrap_Export #-} +wrap_Export :: T_Export -> Inh_Export -> (Syn_Export ) +wrap_Export (T_Export act) (Inh_Export ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Export_vIn34 + (T_Export_vOut34 _lhsOself) <- return (inv_Export_s35 sem arg) + return (Syn_Export _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Export #-} +sem_Export :: Export -> T_Export +sem_Export ( Export_Variable range_ name_ ) = sem_Export_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_TypeOrClass range_ name_ names_ ) = sem_Export_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Export ( Export_TypeOrClassComplete range_ name_ ) = sem_Export_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_Module range_ name_ ) = sem_Export_Module ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Export = T_Export { + attach_T_Export :: Identity (T_Export_s35 ) + } +newtype T_Export_s35 = C_Export_s35 { + inv_Export_s35 :: (T_Export_v34 ) + } +data T_Export_s36 = C_Export_s36 +type T_Export_v34 = (T_Export_vIn34 ) -> (T_Export_vOut34 ) +data T_Export_vIn34 = T_Export_vIn34 +data T_Export_vOut34 = T_Export_vOut34 (Export) +{-# NOINLINE sem_Export_Variable #-} +sem_Export_Variable :: T_Range -> T_Name -> T_Export +sem_Export_Variable arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule101 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule102 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule101 #-} + rule101 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Variable _rangeIself _nameIself + {-# INLINE rule102 #-} + rule102 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClass #-} +sem_Export_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Export +sem_Export_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _self = rule103 _nameIself _namesIself _rangeIself + _lhsOself :: Export + _lhsOself = rule104 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule103 #-} + rule103 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Export_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule104 #-} + rule104 = \ _self -> + _self +{-# NOINLINE sem_Export_TypeOrClassComplete #-} +sem_Export_TypeOrClassComplete :: T_Range -> T_Name -> T_Export +sem_Export_TypeOrClassComplete arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule105 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule106 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule105 #-} + rule105 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule106 #-} + rule106 = \ _self -> + _self +{-# NOINLINE sem_Export_Module #-} +sem_Export_Module :: T_Range -> T_Name -> T_Export +sem_Export_Module arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule107 _nameIself _rangeIself + _lhsOself :: Export + _lhsOself = rule108 _self + __result_ = T_Export_vOut34 _lhsOself + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule107 #-} + rule107 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Export_Module _rangeIself _nameIself + {-# INLINE rule108 #-} + rule108 = \ _self -> + _self + +-- Exports ----------------------------------------------------- +-- wrapper +data Inh_Exports = Inh_Exports { } +data Syn_Exports = Syn_Exports { self_Syn_Exports :: (Exports) } +{-# INLINABLE wrap_Exports #-} +wrap_Exports :: T_Exports -> Inh_Exports -> (Syn_Exports ) +wrap_Exports (T_Exports act) (Inh_Exports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Exports_vIn37 + (T_Exports_vOut37 _lhsOself) <- return (inv_Exports_s38 sem arg) + return (Syn_Exports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Exports #-} +sem_Exports :: Exports -> T_Exports +sem_Exports list = Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list) + +-- semantic domain +newtype T_Exports = T_Exports { + attach_T_Exports :: Identity (T_Exports_s38 ) + } +newtype T_Exports_s38 = C_Exports_s38 { + inv_Exports_s38 :: (T_Exports_v37 ) + } +data T_Exports_s39 = C_Exports_s39 +type T_Exports_v37 = (T_Exports_vIn37 ) -> (T_Exports_vOut37 ) +data T_Exports_vIn37 = T_Exports_vIn37 +data T_Exports_vOut37 = T_Exports_vOut37 (Exports) +{-# NOINLINE sem_Exports_Cons #-} +sem_Exports_Cons :: T_Export -> T_Exports -> T_Exports +sem_Exports_Cons arg_hd_ arg_tl_ = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Export (arg_hd_)) + _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_tl_)) + (T_Export_vOut34 _hdIself) = inv_Export_s35 _hdX35 (T_Export_vIn34 ) + (T_Exports_vOut37 _tlIself) = inv_Exports_s38 _tlX38 (T_Exports_vIn37 ) + _self = rule109 _hdIself _tlIself + _lhsOself :: Exports + _lhsOself = rule110 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule109 #-} + rule109 = \ ((_hdIself) :: Export) ((_tlIself) :: Exports) -> + (:) _hdIself _tlIself + {-# INLINE rule110 #-} + rule110 = \ _self -> + _self +{-# NOINLINE sem_Exports_Nil #-} +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _self = rule111 () + _lhsOself :: Exports + _lhsOself = rule112 _self + __result_ = T_Exports_vOut37 _lhsOself + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule111 #-} + rule111 = \ (_ :: ()) -> + [] + {-# INLINE rule112 #-} + rule112 = \ _self -> + _self + +-- Expression -------------------------------------------------- +-- wrapper +data Inh_Expression = Inh_Expression { } +data Syn_Expression = Syn_Expression { oneLineTree_Syn_Expression :: (OneLineTree), self_Syn_Expression :: (Expression) } +{-# INLINABLE wrap_Expression #-} +wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) +wrap_Expression (T_Expression act) (Inh_Expression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expression_vIn40 + (T_Expression_vOut40 _lhsOoneLineTree _lhsOself) <- return (inv_Expression_s41 sem arg) + return (Syn_Expression _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expression #-} +sem_Expression :: Expression -> T_Expression +sem_Expression ( Expression_Hole range_ id_ ) = sem_Expression_Hole ( sem_Range range_ ) id_ +sem_Expression ( Expression_Feedback range_ feedback_ expression_ ) = sem_Expression_Feedback ( sem_Range range_ ) feedback_ ( sem_Expression expression_ ) +sem_Expression ( Expression_MustUse range_ expression_ ) = sem_Expression_MustUse ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Literal range_ literal_ ) = sem_Expression_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Expression ( Expression_Variable range_ name_ ) = sem_Expression_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Constructor range_ name_ ) = sem_Expression_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Parenthesized range_ expression_ ) = sem_Expression_Parenthesized ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NormalApplication range_ function_ arguments_ ) = sem_Expression_NormalApplication ( sem_Range range_ ) ( sem_Expression function_ ) ( sem_Expressions arguments_ ) +sem_Expression ( Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ ) = sem_Expression_InfixApplication ( sem_Range range_ ) ( sem_MaybeExpression leftExpression_ ) ( sem_Expression operator_ ) ( sem_MaybeExpression rightExpression_ ) +sem_Expression ( Expression_If range_ guardExpression_ thenExpression_ elseExpression_ ) = sem_Expression_If ( sem_Range range_ ) ( sem_Expression guardExpression_ ) ( sem_Expression thenExpression_ ) ( sem_Expression elseExpression_ ) +sem_Expression ( Expression_Lambda range_ patterns_ expression_ ) = sem_Expression_Lambda ( sem_Range range_ ) ( sem_Patterns patterns_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Case range_ expression_ alternatives_ ) = sem_Expression_Case ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Alternatives alternatives_ ) +sem_Expression ( Expression_Let range_ declarations_ expression_ ) = sem_Expression_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Do range_ statements_ ) = sem_Expression_Do ( sem_Range range_ ) ( sem_Statements statements_ ) +sem_Expression ( Expression_List range_ expressions_ ) = sem_Expression_List ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Tuple range_ expressions_ ) = sem_Expression_Tuple ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Comprehension range_ expression_ qualifiers_ ) = sem_Expression_Comprehension ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Qualifiers qualifiers_ ) +sem_Expression ( Expression_Typed range_ expression_ type_ ) = sem_Expression_Typed ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Type type_ ) +sem_Expression ( Expression_RecordConstruction range_ name_ recordExpressionBindings_ ) = sem_Expression_RecordConstruction ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_RecordUpdate range_ expression_ recordExpressionBindings_ ) = sem_Expression_RecordUpdate ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_Enum range_ from_ then_ to_ ) = sem_Expression_Enum ( sem_Range range_ ) ( sem_Expression from_ ) ( sem_MaybeExpression then_ ) ( sem_MaybeExpression to_ ) +sem_Expression ( Expression_Negate range_ expression_ ) = sem_Expression_Negate ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NegateFloat range_ expression_ ) = sem_Expression_NegateFloat ( sem_Range range_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_Expression = T_Expression { + attach_T_Expression :: Identity (T_Expression_s41 ) + } +newtype T_Expression_s41 = C_Expression_s41 { + inv_Expression_s41 :: (T_Expression_v40 ) + } +data T_Expression_s42 = C_Expression_s42 +type T_Expression_v40 = (T_Expression_vIn40 ) -> (T_Expression_vOut40 ) +data T_Expression_vIn40 = T_Expression_vIn40 +data T_Expression_vOut40 = T_Expression_vOut40 (OneLineTree) (Expression) +{-# NOINLINE sem_Expression_Hole #-} +sem_Expression_Hole :: T_Range -> (Integer) -> T_Expression +sem_Expression_Hole arg_range_ arg_id_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule113 () + _self = rule114 _rangeIself arg_id_ + _lhsOself :: Expression + _lhsOself = rule115 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule116 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule113 #-} + rule113 = \ (_ :: ()) -> + OneLineNode [OneLineText hole] + {-# INLINE rule114 #-} + rule114 = \ ((_rangeIself) :: Range) id_ -> + Expression_Hole _rangeIself id_ + {-# INLINE rule115 #-} + rule115 = \ _self -> + _self + {-# INLINE rule116 #-} + rule116 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Feedback #-} +sem_Expression_Feedback :: T_Range -> (String) -> T_Expression -> T_Expression +sem_Expression_Feedback arg_range_ arg_feedback_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule117 _expressionIself _rangeIself arg_feedback_ + _lhsOself :: Expression + _lhsOself = rule118 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule119 _expressionIoneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule117 #-} + rule117 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) feedback_ -> + Expression_Feedback _rangeIself feedback_ _expressionIself + {-# INLINE rule118 #-} + rule118 = \ _self -> + _self + {-# INLINE rule119 #-} + rule119 = \ ((_expressionIoneLineTree) :: OneLineTree) -> + _expressionIoneLineTree +{-# NOINLINE sem_Expression_MustUse #-} +sem_Expression_MustUse :: T_Range -> T_Expression -> T_Expression +sem_Expression_MustUse arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule120 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule121 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule122 _expressionIoneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule120 #-} + rule120 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_MustUse _rangeIself _expressionIself + {-# INLINE rule121 #-} + rule121 = \ _self -> + _self + {-# INLINE rule122 #-} + rule122 = \ ((_expressionIoneLineTree) :: OneLineTree) -> + _expressionIoneLineTree +{-# NOINLINE sem_Expression_Literal #-} +sem_Expression_Literal :: T_Range -> T_Literal -> T_Expression +sem_Expression_Literal arg_range_ arg_literal_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIoneLineTree _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _oneLineTree = rule123 _literalIoneLineTree + _self = rule124 _literalIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule125 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule126 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule123 #-} + rule123 = \ ((_literalIoneLineTree) :: OneLineTree) -> + OneLineNode [_literalIoneLineTree] + {-# INLINE rule124 #-} + rule124 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Expression_Literal _rangeIself _literalIself + {-# INLINE rule125 #-} + rule125 = \ _self -> + _self + {-# INLINE rule126 #-} + rule126 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Variable #-} +sem_Expression_Variable :: T_Range -> T_Name -> T_Expression +sem_Expression_Variable arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _oneLineTree = rule127 _nameIoneLineTree + _self = rule128 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule129 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule130 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule127 #-} + rule127 = \ ((_nameIoneLineTree) :: OneLineTree) -> + OneLineNode [_nameIoneLineTree] + {-# INLINE rule128 #-} + rule128 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Variable _rangeIself _nameIself + {-# INLINE rule129 #-} + rule129 = \ _self -> + _self + {-# INLINE rule130 #-} + rule130 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Constructor #-} +sem_Expression_Constructor :: T_Range -> T_Name -> T_Expression +sem_Expression_Constructor arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _oneLineTree = rule131 _nameIoneLineTree + _self = rule132 _nameIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule133 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule134 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule131 #-} + rule131 = \ ((_nameIoneLineTree) :: OneLineTree) -> + OneLineNode [_nameIoneLineTree] + {-# INLINE rule132 #-} + rule132 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Expression_Constructor _rangeIself _nameIself + {-# INLINE rule133 #-} + rule133 = \ _self -> + _self + {-# INLINE rule134 #-} + rule134 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Parenthesized #-} +sem_Expression_Parenthesized :: T_Range -> T_Expression -> T_Expression +sem_Expression_Parenthesized arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _oneLineTree = rule135 _expressionIoneLineTree + _self = rule136 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule137 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule138 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule135 #-} + rule135 = \ ((_expressionIoneLineTree) :: OneLineTree) -> + parens _expressionIoneLineTree + {-# INLINE rule136 #-} + rule136 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Parenthesized _rangeIself _expressionIself + {-# INLINE rule137 #-} + rule137 = \ _self -> + _self + {-# INLINE rule138 #-} + rule138 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_NormalApplication #-} +sem_Expression_NormalApplication :: T_Range -> T_Expression -> T_Expressions -> T_Expression +sem_Expression_NormalApplication arg_range_ arg_function_ arg_arguments_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_function_)) + _argumentsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _functionIoneLineTree _functionIself) = inv_Expression_s41 _functionX41 (T_Expression_vIn40 ) + (T_Expressions_vOut43 _argumentsIoneLineTree _argumentsIself) = inv_Expressions_s44 _argumentsX44 (T_Expressions_vIn43 ) + _oneLineTree = rule139 _argumentsIoneLineTree _functionIoneLineTree + _self = rule140 _argumentsIself _functionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule141 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule142 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule139 #-} + rule139 = \ ((_argumentsIoneLineTree) :: [ OneLineTree] ) ((_functionIoneLineTree) :: OneLineTree) -> + punctuate " " (_functionIoneLineTree : _argumentsIoneLineTree) + {-# INLINE rule140 #-} + rule140 = \ ((_argumentsIself) :: Expressions) ((_functionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NormalApplication _rangeIself _functionIself _argumentsIself + {-# INLINE rule141 #-} + rule141 = \ _self -> + _self + {-# INLINE rule142 #-} + rule142 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_InfixApplication #-} +sem_Expression_InfixApplication :: T_Range -> T_MaybeExpression -> T_Expression -> T_MaybeExpression -> T_Expression +sem_Expression_InfixApplication arg_range_ arg_leftExpression_ arg_operator_ arg_rightExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_leftExpression_)) + _operatorX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_operator_)) + _rightExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_rightExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeExpression_vOut94 _leftExpressionIoneLineTree _leftExpressionIself) = inv_MaybeExpression_s95 _leftExpressionX95 (T_MaybeExpression_vIn94 ) + (T_Expression_vOut40 _operatorIoneLineTree _operatorIself) = inv_Expression_s41 _operatorX41 (T_Expression_vIn40 ) + (T_MaybeExpression_vOut94 _rightExpressionIoneLineTree _rightExpressionIself) = inv_MaybeExpression_s95 _rightExpressionX95 (T_MaybeExpression_vIn94 ) + _operatorName = rule143 _operatorIoneLineTree + _oneLineTree = rule144 _leftExpressionIoneLineTree _operatorName _rightExpressionIoneLineTree + _self = rule145 _leftExpressionIself _operatorIself _rangeIself _rightExpressionIself + _lhsOself :: Expression + _lhsOself = rule146 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule147 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule143 #-} + rule143 = \ ((_operatorIoneLineTree) :: OneLineTree) -> + oneLineTreeAsOperator _operatorIoneLineTree + {-# INLINE rule144 #-} + rule144 = \ ((_leftExpressionIoneLineTree) :: Maybe OneLineTree ) _operatorName ((_rightExpressionIoneLineTree) :: Maybe OneLineTree ) -> + case (_leftExpressionIoneLineTree, _rightExpressionIoneLineTree) of + (Nothing, Nothing) -> parens _operatorName + (Just l , Nothing) -> encloseSep "(" " " ")" [l, _operatorName] + (Nothing, Just r ) -> encloseSep "(" " " ")" [_operatorName, r] + (Just l , Just r ) -> OneLineNode [ l, OneLineText " ", _operatorName, OneLineText " ", r ] + {-# INLINE rule145 #-} + rule145 = \ ((_leftExpressionIself) :: MaybeExpression) ((_operatorIself) :: Expression) ((_rangeIself) :: Range) ((_rightExpressionIself) :: MaybeExpression) -> + Expression_InfixApplication _rangeIself _leftExpressionIself _operatorIself _rightExpressionIself + {-# INLINE rule146 #-} + rule146 = \ _self -> + _self + {-# INLINE rule147 #-} + rule147 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_If #-} +sem_Expression_If :: T_Range -> T_Expression -> T_Expression -> T_Expression -> T_Expression +sem_Expression_If arg_range_ arg_guardExpression_ arg_thenExpression_ arg_elseExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guardExpression_)) + _thenExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_thenExpression_)) + _elseExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_elseExpression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardExpressionIoneLineTree _guardExpressionIself) = inv_Expression_s41 _guardExpressionX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _thenExpressionIoneLineTree _thenExpressionIself) = inv_Expression_s41 _thenExpressionX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _elseExpressionIoneLineTree _elseExpressionIself) = inv_Expression_s41 _elseExpressionX41 (T_Expression_vIn40 ) + _oneLineTree = rule148 _elseExpressionIoneLineTree _guardExpressionIoneLineTree _thenExpressionIoneLineTree + _self = rule149 _elseExpressionIself _guardExpressionIself _rangeIself _thenExpressionIself + _lhsOself :: Expression + _lhsOself = rule150 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule151 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule148 #-} + rule148 = \ ((_elseExpressionIoneLineTree) :: OneLineTree) ((_guardExpressionIoneLineTree) :: OneLineTree) ((_thenExpressionIoneLineTree) :: OneLineTree) -> + OneLineNode + [ OneLineText "if " + , OneLineNode [_guardExpressionIoneLineTree] + , OneLineText " then " + , OneLineNode [_thenExpressionIoneLineTree] + , OneLineText " else " + , OneLineNode [_elseExpressionIoneLineTree] + ] + {-# INLINE rule149 #-} + rule149 = \ ((_elseExpressionIself) :: Expression) ((_guardExpressionIself) :: Expression) ((_rangeIself) :: Range) ((_thenExpressionIself) :: Expression) -> + Expression_If _rangeIself _guardExpressionIself _thenExpressionIself _elseExpressionIself + {-# INLINE rule150 #-} + rule150 = \ _self -> + _self + {-# INLINE rule151 #-} + rule151 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Lambda #-} +sem_Expression_Lambda :: T_Range -> T_Patterns -> T_Expression -> T_Expression +sem_Expression_Lambda arg_range_ arg_patterns_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIoneLineTree _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _oneLineTree = rule152 _expressionIoneLineTree _patternsIoneLineTree + _self = rule153 _expressionIself _patternsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule154 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule155 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule152 #-} + rule152 = \ ((_expressionIoneLineTree) :: OneLineTree) ((_patternsIoneLineTree) :: [ OneLineTree] ) -> + OneLineNode + ( [ OneLineText "\\", punctuate " " _patternsIoneLineTree, OneLineText " -> " + , OneLineNode [_expressionIoneLineTree] + ] + ) + {-# INLINE rule153 #-} + rule153 = \ ((_expressionIself) :: Expression) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Expression_Lambda _rangeIself _patternsIself _expressionIself + {-# INLINE rule154 #-} + rule154 = \ _self -> + _self + {-# INLINE rule155 #-} + rule155 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Case #-} +sem_Expression_Case :: T_Range -> T_Expression -> T_Alternatives -> T_Expression +sem_Expression_Case arg_range_ arg_expression_ arg_alternatives_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _alternativesX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_alternatives_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Alternatives_vOut4 _alternativesIoneLineTree _alternativesIself) = inv_Alternatives_s5 _alternativesX5 (T_Alternatives_vIn4 ) + _oneLineTree = rule156 _alternativesIoneLineTree _expressionIoneLineTree + _self = rule157 _alternativesIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule158 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule159 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule156 #-} + rule156 = \ ((_alternativesIoneLineTree) :: [ OneLineTree] ) ((_expressionIoneLineTree) :: OneLineTree) -> + OneLineNode + [ OneLineText "case " + , OneLineNode [_expressionIoneLineTree] + , OneLineText " of " + , encloseSep "{" "; " "}" _alternativesIoneLineTree + ] + {-# INLINE rule157 #-} + rule157 = \ ((_alternativesIself) :: Alternatives) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Case _rangeIself _expressionIself _alternativesIself + {-# INLINE rule158 #-} + rule158 = \ _self -> + _self + {-# INLINE rule159 #-} + rule159 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Let #-} +sem_Expression_Let :: T_Range -> T_Declarations -> T_Expression -> T_Expression +sem_Expression_Let arg_range_ arg_declarations_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIoneLineTree _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _oneLineTree = rule160 _declarationsIoneLineTree _expressionIoneLineTree + _self = rule161 _declarationsIself _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule162 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule163 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule160 #-} + rule160 = \ ((_declarationsIoneLineTree) :: [ OneLineTree] ) ((_expressionIoneLineTree) :: OneLineTree) -> + OneLineNode + [ OneLineText "let " + , encloseSep "{" "; " "}" _declarationsIoneLineTree + , OneLineText " in " + , OneLineNode [_expressionIoneLineTree] + ] + {-# INLINE rule161 #-} + rule161 = \ ((_declarationsIself) :: Declarations) ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Let _rangeIself _declarationsIself _expressionIself + {-# INLINE rule162 #-} + rule162 = \ _self -> + _self + {-# INLINE rule163 #-} + rule163 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Do #-} +sem_Expression_Do :: T_Range -> T_Statements -> T_Expression +sem_Expression_Do arg_range_ arg_statements_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _statementsX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_statements_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Statements_vOut157 _statementsIoneLineTree _statementsIself) = inv_Statements_s158 _statementsX158 (T_Statements_vIn157 ) + _oneLineTree = rule164 _statementsIoneLineTree + _self = rule165 _rangeIself _statementsIself + _lhsOself :: Expression + _lhsOself = rule166 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule167 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule164 #-} + rule164 = \ ((_statementsIoneLineTree) :: [ OneLineTree] ) -> + OneLineNode + [ OneLineText "do " + , OneLineNode (sepBy (OneLineText "; ") _statementsIoneLineTree) + ] + {-# INLINE rule165 #-} + rule165 = \ ((_rangeIself) :: Range) ((_statementsIself) :: Statements) -> + Expression_Do _rangeIself _statementsIself + {-# INLINE rule166 #-} + rule166 = \ _self -> + _self + {-# INLINE rule167 #-} + rule167 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_List #-} +sem_Expression_List :: T_Range -> T_Expressions -> T_Expression +sem_Expression_List arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIoneLineTree _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 ) + _oneLineTree = rule168 _expressionsIoneLineTree + _self = rule169 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule170 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule171 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule168 #-} + rule168 = \ ((_expressionsIoneLineTree) :: [ OneLineTree] ) -> + encloseSep "[" ", " "]" _expressionsIoneLineTree + {-# INLINE rule169 #-} + rule169 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_List _rangeIself _expressionsIself + {-# INLINE rule170 #-} + rule170 = \ _self -> + _self + {-# INLINE rule171 #-} + rule171 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Tuple #-} +sem_Expression_Tuple :: T_Range -> T_Expressions -> T_Expression +sem_Expression_Tuple arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsIoneLineTree _expressionsIself) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 ) + _oneLineTree = rule172 _expressionsIoneLineTree + _self = rule173 _expressionsIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule174 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule175 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule172 #-} + rule172 = \ ((_expressionsIoneLineTree) :: [ OneLineTree] ) -> + encloseSep "(" ", " ")" _expressionsIoneLineTree + {-# INLINE rule173 #-} + rule173 = \ ((_expressionsIself) :: Expressions) ((_rangeIself) :: Range) -> + Expression_Tuple _rangeIself _expressionsIself + {-# INLINE rule174 #-} + rule174 = \ _self -> + _self + {-# INLINE rule175 #-} + rule175 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Comprehension #-} +sem_Expression_Comprehension :: T_Range -> T_Expression -> T_Qualifiers -> T_Expression +sem_Expression_Comprehension arg_range_ arg_expression_ arg_qualifiers_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _qualifiersX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_qualifiers_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Qualifiers_vOut130 _qualifiersIoneLineTree _qualifiersIself) = inv_Qualifiers_s131 _qualifiersX131 (T_Qualifiers_vIn130 ) + _oneLineTree = rule176 _expressionIoneLineTree _qualifiersIoneLineTree + _self = rule177 _expressionIself _qualifiersIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule178 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule179 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule176 #-} + rule176 = \ ((_expressionIoneLineTree) :: OneLineTree) ((_qualifiersIoneLineTree) :: [ OneLineTree] ) -> + OneLineNode + [ OneLineText "[ " + , OneLineNode [_expressionIoneLineTree] + , OneLineText " | " + , OneLineNode [ punctuate ", " _qualifiersIoneLineTree ] + , OneLineText " ]" + ] + {-# INLINE rule177 #-} + rule177 = \ ((_expressionIself) :: Expression) ((_qualifiersIself) :: Qualifiers) ((_rangeIself) :: Range) -> + Expression_Comprehension _rangeIself _expressionIself _qualifiersIself + {-# INLINE rule178 #-} + rule178 = \ _self -> + _self + {-# INLINE rule179 #-} + rule179 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Typed #-} +sem_Expression_Typed :: T_Range -> T_Expression -> T_Type -> T_Expression +sem_Expression_Typed arg_range_ arg_expression_ arg_type_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _oneLineTree = rule180 _expressionIoneLineTree _typeIself + _self = rule181 _expressionIself _rangeIself _typeIself + _lhsOself :: Expression + _lhsOself = rule182 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule183 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule180 #-} + rule180 = \ ((_expressionIoneLineTree) :: OneLineTree) ((_typeIself) :: Type) -> + OneLineNode + [ OneLineNode [_expressionIoneLineTree] + , OneLineText " :: " + , OneLineNode [ OneLineText (show (makeTpSchemeFromType _typeIself))] + ] + {-# INLINE rule181 #-} + rule181 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Expression_Typed _rangeIself _expressionIself _typeIself + {-# INLINE rule182 #-} + rule182 = \ _self -> + _self + {-# INLINE rule183 #-} + rule183 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_RecordConstruction #-} +sem_Expression_RecordConstruction :: T_Range -> T_Name -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordConstruction arg_range_ arg_name_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 ) + _oneLineTree = rule184 () + _self = rule185 _nameIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule186 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule187 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule184 #-} + rule184 = \ (_ :: ()) -> + intErr "Expression" "record construction" + {-# INLINE rule185 #-} + rule185 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordConstruction _rangeIself _nameIself _recordExpressionBindingsIself + {-# INLINE rule186 #-} + rule186 = \ _self -> + _self + {-# INLINE rule187 #-} + rule187 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_RecordUpdate #-} +sem_Expression_RecordUpdate :: T_Range -> T_Expression -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordUpdate arg_range_ arg_expression_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsIself) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 ) + _oneLineTree = rule188 () + _self = rule189 _expressionIself _rangeIself _recordExpressionBindingsIself + _lhsOself :: Expression + _lhsOself = rule190 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule191 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule188 #-} + rule188 = \ (_ :: ()) -> + intErr "Expression" "record update" + {-# INLINE rule189 #-} + rule189 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_recordExpressionBindingsIself) :: RecordExpressionBindings) -> + Expression_RecordUpdate _rangeIself _expressionIself _recordExpressionBindingsIself + {-# INLINE rule190 #-} + rule190 = \ _self -> + _self + {-# INLINE rule191 #-} + rule191 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Enum #-} +sem_Expression_Enum :: T_Range -> T_Expression -> T_MaybeExpression -> T_MaybeExpression -> T_Expression +sem_Expression_Enum arg_range_ arg_from_ arg_then_ arg_to_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fromX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_from_)) + _thenX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_then_)) + _toX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_to_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _fromIoneLineTree _fromIself) = inv_Expression_s41 _fromX41 (T_Expression_vIn40 ) + (T_MaybeExpression_vOut94 _thenIoneLineTree _thenIself) = inv_MaybeExpression_s95 _thenX95 (T_MaybeExpression_vIn94 ) + (T_MaybeExpression_vOut94 _toIoneLineTree _toIself) = inv_MaybeExpression_s95 _toX95 (T_MaybeExpression_vIn94 ) + _oneLineTree = rule192 _fromIoneLineTree _thenIoneLineTree _toIoneLineTree + _self = rule193 _fromIself _rangeIself _thenIself _toIself + _lhsOself :: Expression + _lhsOself = rule194 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule195 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule192 #-} + rule192 = \ ((_fromIoneLineTree) :: OneLineTree) ((_thenIoneLineTree) :: Maybe OneLineTree ) ((_toIoneLineTree) :: Maybe OneLineTree ) -> + OneLineNode ( + [ OneLineText "[" + , OneLineNode [_fromIoneLineTree] + ] + ++ + maybe [] (\x -> [OneLineText ", ", x]) _thenIoneLineTree + ++ + [ OneLineText " .. " ] + ++ + maybe [] (\x -> [OneLineNode [x]]) _toIoneLineTree + ++ + [ OneLineText "]" ] + ) + {-# INLINE rule193 #-} + rule193 = \ ((_fromIself) :: Expression) ((_rangeIself) :: Range) ((_thenIself) :: MaybeExpression) ((_toIself) :: MaybeExpression) -> + Expression_Enum _rangeIself _fromIself _thenIself _toIself + {-# INLINE rule194 #-} + rule194 = \ _self -> + _self + {-# INLINE rule195 #-} + rule195 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_Negate #-} +sem_Expression_Negate :: T_Range -> T_Expression -> T_Expression +sem_Expression_Negate arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _oneLineTree = rule196 _expressionIoneLineTree + _self = rule197 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule198 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule199 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule196 #-} + rule196 = \ ((_expressionIoneLineTree) :: OneLineTree) -> + OneLineNode [ OneLineText "-", OneLineNode [_expressionIoneLineTree] ] + {-# INLINE rule197 #-} + rule197 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_Negate _rangeIself _expressionIself + {-# INLINE rule198 #-} + rule198 = \ _self -> + _self + {-# INLINE rule199 #-} + rule199 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Expression_NegateFloat #-} +sem_Expression_NegateFloat :: T_Range -> T_Expression -> T_Expression +sem_Expression_NegateFloat arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _oneLineTree = rule200 _expressionIoneLineTree + _self = rule201 _expressionIself _rangeIself + _lhsOself :: Expression + _lhsOself = rule202 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule203 _oneLineTree + __result_ = T_Expression_vOut40 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule200 #-} + rule200 = \ ((_expressionIoneLineTree) :: OneLineTree) -> + OneLineNode [ OneLineText "-.", OneLineNode [_expressionIoneLineTree] ] + {-# INLINE rule201 #-} + rule201 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Expression_NegateFloat _rangeIself _expressionIself + {-# INLINE rule202 #-} + rule202 = \ _self -> + _self + {-# INLINE rule203 #-} + rule203 = \ _oneLineTree -> + _oneLineTree + +-- Expressions ------------------------------------------------- +-- wrapper +data Inh_Expressions = Inh_Expressions { } +data Syn_Expressions = Syn_Expressions { oneLineTree_Syn_Expressions :: ( [ OneLineTree] ), self_Syn_Expressions :: (Expressions) } +{-# INLINABLE wrap_Expressions #-} +wrap_Expressions :: T_Expressions -> Inh_Expressions -> (Syn_Expressions ) +wrap_Expressions (T_Expressions act) (Inh_Expressions ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expressions_vIn43 + (T_Expressions_vOut43 _lhsOoneLineTree _lhsOself) <- return (inv_Expressions_s44 sem arg) + return (Syn_Expressions _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Expressions #-} +sem_Expressions :: Expressions -> T_Expressions +sem_Expressions list = Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list) + +-- semantic domain +newtype T_Expressions = T_Expressions { + attach_T_Expressions :: Identity (T_Expressions_s44 ) + } +newtype T_Expressions_s44 = C_Expressions_s44 { + inv_Expressions_s44 :: (T_Expressions_v43 ) + } +data T_Expressions_s45 = C_Expressions_s45 +type T_Expressions_v43 = (T_Expressions_vIn43 ) -> (T_Expressions_vOut43 ) +data T_Expressions_vIn43 = T_Expressions_vIn43 +data T_Expressions_vOut43 = T_Expressions_vOut43 ( [ OneLineTree] ) (Expressions) +{-# NOINLINE sem_Expressions_Cons #-} +sem_Expressions_Cons :: T_Expression -> T_Expressions -> T_Expressions +sem_Expressions_Cons arg_hd_ arg_tl_ = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 ) -> ( let + _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_hd_)) + _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_tl_)) + (T_Expression_vOut40 _hdIoneLineTree _hdIself) = inv_Expression_s41 _hdX41 (T_Expression_vIn40 ) + (T_Expressions_vOut43 _tlIoneLineTree _tlIself) = inv_Expressions_s44 _tlX44 (T_Expressions_vIn43 ) + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule204 _hdIoneLineTree _tlIoneLineTree + _self = rule205 _hdIself _tlIself + _lhsOself :: Expressions + _lhsOself = rule206 _self + __result_ = T_Expressions_vOut43 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule204 #-} + rule204 = \ ((_hdIoneLineTree) :: OneLineTree) ((_tlIoneLineTree) :: [ OneLineTree] ) -> + _hdIoneLineTree : _tlIoneLineTree + {-# INLINE rule205 #-} + rule205 = \ ((_hdIself) :: Expression) ((_tlIself) :: Expressions) -> + (:) _hdIself _tlIself + {-# INLINE rule206 #-} + rule206 = \ _self -> + _self +{-# NOINLINE sem_Expressions_Nil #-} +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 ) -> ( let + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule207 () + _self = rule208 () + _lhsOself :: Expressions + _lhsOself = rule209 _self + __result_ = T_Expressions_vOut43 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule207 #-} + rule207 = \ (_ :: ()) -> + [] + {-# INLINE rule208 #-} + rule208 = \ (_ :: ()) -> + [] + {-# INLINE rule209 #-} + rule209 = \ _self -> + _self + +-- FieldDeclaration -------------------------------------------- +-- wrapper +data Inh_FieldDeclaration = Inh_FieldDeclaration { } +data Syn_FieldDeclaration = Syn_FieldDeclaration { self_Syn_FieldDeclaration :: (FieldDeclaration) } +{-# INLINABLE wrap_FieldDeclaration #-} +wrap_FieldDeclaration :: T_FieldDeclaration -> Inh_FieldDeclaration -> (Syn_FieldDeclaration ) +wrap_FieldDeclaration (T_FieldDeclaration act) (Inh_FieldDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclaration_vIn46 + (T_FieldDeclaration_vOut46 _lhsOself) <- return (inv_FieldDeclaration_s47 sem arg) + return (Syn_FieldDeclaration _lhsOself) + ) + +-- cata +{-# INLINE sem_FieldDeclaration #-} +sem_FieldDeclaration :: FieldDeclaration -> T_FieldDeclaration +sem_FieldDeclaration ( FieldDeclaration_FieldDeclaration range_ names_ type_ ) = sem_FieldDeclaration_FieldDeclaration ( sem_Range range_ ) ( sem_Names names_ ) ( sem_AnnotatedType type_ ) + +-- semantic domain +newtype T_FieldDeclaration = T_FieldDeclaration { + attach_T_FieldDeclaration :: Identity (T_FieldDeclaration_s47 ) + } +newtype T_FieldDeclaration_s47 = C_FieldDeclaration_s47 { + inv_FieldDeclaration_s47 :: (T_FieldDeclaration_v46 ) + } +data T_FieldDeclaration_s48 = C_FieldDeclaration_s48 +type T_FieldDeclaration_v46 = (T_FieldDeclaration_vIn46 ) -> (T_FieldDeclaration_vOut46 ) +data T_FieldDeclaration_vIn46 = T_FieldDeclaration_vIn46 +data T_FieldDeclaration_vOut46 = T_FieldDeclaration_vOut46 (FieldDeclaration) +{-# NOINLINE sem_FieldDeclaration_FieldDeclaration #-} +sem_FieldDeclaration_FieldDeclaration :: T_Range -> T_Names -> T_AnnotatedType -> T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration arg_range_ arg_names_ arg_type_ = T_FieldDeclaration (return st47) where + {-# NOINLINE st47 #-} + st47 = let + v46 :: T_FieldDeclaration_v46 + v46 = \ (T_FieldDeclaration_vIn46 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIisIdentifier _namesIisOperator _namesIisSpecial _namesIoneLineTree _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_AnnotatedType_vOut7 _typeIself) = inv_AnnotatedType_s8 _typeX8 (T_AnnotatedType_vIn7 ) + _self = rule210 _namesIself _rangeIself _typeIself + _lhsOself :: FieldDeclaration + _lhsOself = rule211 _self + __result_ = T_FieldDeclaration_vOut46 _lhsOself + in __result_ ) + in C_FieldDeclaration_s47 v46 + {-# INLINE rule210 #-} + rule210 = \ ((_namesIself) :: Names) ((_rangeIself) :: Range) ((_typeIself) :: AnnotatedType) -> + FieldDeclaration_FieldDeclaration _rangeIself _namesIself _typeIself + {-# INLINE rule211 #-} + rule211 = \ _self -> + _self + +-- FieldDeclarations ------------------------------------------- +-- wrapper +data Inh_FieldDeclarations = Inh_FieldDeclarations { } +data Syn_FieldDeclarations = Syn_FieldDeclarations { self_Syn_FieldDeclarations :: (FieldDeclarations) } +{-# INLINABLE wrap_FieldDeclarations #-} +wrap_FieldDeclarations :: T_FieldDeclarations -> Inh_FieldDeclarations -> (Syn_FieldDeclarations ) +wrap_FieldDeclarations (T_FieldDeclarations act) (Inh_FieldDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclarations_vIn49 + (T_FieldDeclarations_vOut49 _lhsOself) <- return (inv_FieldDeclarations_s50 sem arg) + return (Syn_FieldDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FieldDeclarations #-} +sem_FieldDeclarations :: FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations list = Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list) + +-- semantic domain +newtype T_FieldDeclarations = T_FieldDeclarations { + attach_T_FieldDeclarations :: Identity (T_FieldDeclarations_s50 ) + } +newtype T_FieldDeclarations_s50 = C_FieldDeclarations_s50 { + inv_FieldDeclarations_s50 :: (T_FieldDeclarations_v49 ) + } +data T_FieldDeclarations_s51 = C_FieldDeclarations_s51 +type T_FieldDeclarations_v49 = (T_FieldDeclarations_vIn49 ) -> (T_FieldDeclarations_vOut49 ) +data T_FieldDeclarations_vIn49 = T_FieldDeclarations_vIn49 +data T_FieldDeclarations_vOut49 = T_FieldDeclarations_vOut49 (FieldDeclarations) +{-# NOINLINE sem_FieldDeclarations_Cons #-} +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> T_FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations_Cons arg_hd_ arg_tl_ = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _hdX47 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclaration (arg_hd_)) + _tlX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_tl_)) + (T_FieldDeclaration_vOut46 _hdIself) = inv_FieldDeclaration_s47 _hdX47 (T_FieldDeclaration_vIn46 ) + (T_FieldDeclarations_vOut49 _tlIself) = inv_FieldDeclarations_s50 _tlX50 (T_FieldDeclarations_vIn49 ) + _self = rule212 _hdIself _tlIself + _lhsOself :: FieldDeclarations + _lhsOself = rule213 _self + __result_ = T_FieldDeclarations_vOut49 _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule212 #-} + rule212 = \ ((_hdIself) :: FieldDeclaration) ((_tlIself) :: FieldDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule213 #-} + rule213 = \ _self -> + _self +{-# NOINLINE sem_FieldDeclarations_Nil #-} +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _self = rule214 () + _lhsOself :: FieldDeclarations + _lhsOself = rule215 _self + __result_ = T_FieldDeclarations_vOut49 _lhsOself + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule214 #-} + rule214 = \ (_ :: ()) -> + [] + {-# INLINE rule215 #-} + rule215 = \ _self -> + _self + +-- Fixity ------------------------------------------------------ +-- wrapper +data Inh_Fixity = Inh_Fixity { } +data Syn_Fixity = Syn_Fixity { self_Syn_Fixity :: (Fixity) } +{-# INLINABLE wrap_Fixity #-} +wrap_Fixity :: T_Fixity -> Inh_Fixity -> (Syn_Fixity ) +wrap_Fixity (T_Fixity act) (Inh_Fixity ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Fixity_vIn52 + (T_Fixity_vOut52 _lhsOself) <- return (inv_Fixity_s53 sem arg) + return (Syn_Fixity _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Fixity #-} +sem_Fixity :: Fixity -> T_Fixity +sem_Fixity ( Fixity_Infixl range_ ) = sem_Fixity_Infixl ( sem_Range range_ ) +sem_Fixity ( Fixity_Infixr range_ ) = sem_Fixity_Infixr ( sem_Range range_ ) +sem_Fixity ( Fixity_Infix range_ ) = sem_Fixity_Infix ( sem_Range range_ ) + +-- semantic domain +newtype T_Fixity = T_Fixity { + attach_T_Fixity :: Identity (T_Fixity_s53 ) + } +newtype T_Fixity_s53 = C_Fixity_s53 { + inv_Fixity_s53 :: (T_Fixity_v52 ) + } +data T_Fixity_s54 = C_Fixity_s54 +type T_Fixity_v52 = (T_Fixity_vIn52 ) -> (T_Fixity_vOut52 ) +data T_Fixity_vIn52 = T_Fixity_vIn52 +data T_Fixity_vOut52 = T_Fixity_vOut52 (Fixity) +{-# NOINLINE sem_Fixity_Infixl #-} +sem_Fixity_Infixl :: T_Range -> T_Fixity +sem_Fixity_Infixl arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule216 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule217 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule216 #-} + rule216 = \ ((_rangeIself) :: Range) -> + Fixity_Infixl _rangeIself + {-# INLINE rule217 #-} + rule217 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infixr #-} +sem_Fixity_Infixr :: T_Range -> T_Fixity +sem_Fixity_Infixr arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule218 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule219 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule218 #-} + rule218 = \ ((_rangeIself) :: Range) -> + Fixity_Infixr _rangeIself + {-# INLINE rule219 #-} + rule219 = \ _self -> + _self +{-# NOINLINE sem_Fixity_Infix #-} +sem_Fixity_Infix :: T_Range -> T_Fixity +sem_Fixity_Infix arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule220 _rangeIself + _lhsOself :: Fixity + _lhsOself = rule221 _self + __result_ = T_Fixity_vOut52 _lhsOself + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule220 #-} + rule220 = \ ((_rangeIself) :: Range) -> + Fixity_Infix _rangeIself + {-# INLINE rule221 #-} + rule221 = \ _self -> + _self + +-- FunctionBinding --------------------------------------------- +-- wrapper +data Inh_FunctionBinding = Inh_FunctionBinding { } +data Syn_FunctionBinding = Syn_FunctionBinding { oneLineTree_Syn_FunctionBinding :: (OneLineTree), self_Syn_FunctionBinding :: (FunctionBinding) } +{-# INLINABLE wrap_FunctionBinding #-} +wrap_FunctionBinding :: T_FunctionBinding -> Inh_FunctionBinding -> (Syn_FunctionBinding ) +wrap_FunctionBinding (T_FunctionBinding act) (Inh_FunctionBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBinding_vIn55 + (T_FunctionBinding_vOut55 _lhsOoneLineTree _lhsOself) <- return (inv_FunctionBinding_s56 sem arg) + return (Syn_FunctionBinding _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBinding #-} +sem_FunctionBinding :: FunctionBinding -> T_FunctionBinding +sem_FunctionBinding ( FunctionBinding_Hole range_ id_ ) = sem_FunctionBinding_Hole ( sem_Range range_ ) id_ +sem_FunctionBinding ( FunctionBinding_Feedback range_ feedback_ functionBinding_ ) = sem_FunctionBinding_Feedback ( sem_Range range_ ) feedback_ ( sem_FunctionBinding functionBinding_ ) +sem_FunctionBinding ( FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ ) = sem_FunctionBinding_FunctionBinding ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_RightHandSide righthandside_ ) + +-- semantic domain +newtype T_FunctionBinding = T_FunctionBinding { + attach_T_FunctionBinding :: Identity (T_FunctionBinding_s56 ) + } +newtype T_FunctionBinding_s56 = C_FunctionBinding_s56 { + inv_FunctionBinding_s56 :: (T_FunctionBinding_v55 ) + } +data T_FunctionBinding_s57 = C_FunctionBinding_s57 +type T_FunctionBinding_v55 = (T_FunctionBinding_vIn55 ) -> (T_FunctionBinding_vOut55 ) +data T_FunctionBinding_vIn55 = T_FunctionBinding_vIn55 +data T_FunctionBinding_vOut55 = T_FunctionBinding_vOut55 (OneLineTree) (FunctionBinding) +{-# NOINLINE sem_FunctionBinding_Hole #-} +sem_FunctionBinding_Hole :: T_Range -> (Integer) -> T_FunctionBinding +sem_FunctionBinding_Hole arg_range_ arg_id_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule222 () + _self = rule223 _rangeIself arg_id_ + _lhsOself :: FunctionBinding + _lhsOself = rule224 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule225 _oneLineTree + __result_ = T_FunctionBinding_vOut55 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule222 #-} + rule222 = \ (_ :: ()) -> + OneLineText hole + {-# INLINE rule223 #-} + rule223 = \ ((_rangeIself) :: Range) id_ -> + FunctionBinding_Hole _rangeIself id_ + {-# INLINE rule224 #-} + rule224 = \ _self -> + _self + {-# INLINE rule225 #-} + rule225 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_FunctionBinding_Feedback #-} +sem_FunctionBinding_Feedback :: T_Range -> (String) -> T_FunctionBinding -> T_FunctionBinding +sem_FunctionBinding_Feedback arg_range_ arg_feedback_ arg_functionBinding_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionBindingX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_functionBinding_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBinding_vOut55 _functionBindingIoneLineTree _functionBindingIself) = inv_FunctionBinding_s56 _functionBindingX56 (T_FunctionBinding_vIn55 ) + _self = rule226 _functionBindingIself _rangeIself arg_feedback_ + _lhsOself :: FunctionBinding + _lhsOself = rule227 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule228 _functionBindingIoneLineTree + __result_ = T_FunctionBinding_vOut55 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule226 #-} + rule226 = \ ((_functionBindingIself) :: FunctionBinding) ((_rangeIself) :: Range) feedback_ -> + FunctionBinding_Feedback _rangeIself feedback_ _functionBindingIself + {-# INLINE rule227 #-} + rule227 = \ _self -> + _self + {-# INLINE rule228 #-} + rule228 = \ ((_functionBindingIoneLineTree) :: OneLineTree) -> + _functionBindingIoneLineTree +{-# NOINLINE sem_FunctionBinding_FunctionBinding #-} +sem_FunctionBinding_FunctionBinding :: T_Range -> T_LeftHandSide -> T_RightHandSide -> T_FunctionBinding +sem_FunctionBinding_FunctionBinding arg_range_ arg_lefthandside_ arg_righthandside_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIoneLineTree _lefthandsideIself) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 ) + (T_RightHandSide_vOut148 _righthandsideIoneLineTree _righthandsideIself) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 ) + _oneLineTree = rule229 _lefthandsideIoneLineTree _righthandsideIoneLineTree + _self = rule230 _lefthandsideIself _rangeIself _righthandsideIself + _lhsOself :: FunctionBinding + _lhsOself = rule231 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule232 _oneLineTree + __result_ = T_FunctionBinding_vOut55 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule229 #-} + rule229 = \ ((_lefthandsideIoneLineTree) :: OneLineTree) ((_righthandsideIoneLineTree) :: String -> OneLineTree ) -> + OneLineNode [_lefthandsideIoneLineTree, _righthandsideIoneLineTree " = " ] + {-# INLINE rule230 #-} + rule230 = \ ((_lefthandsideIself) :: LeftHandSide) ((_rangeIself) :: Range) ((_righthandsideIself) :: RightHandSide) -> + FunctionBinding_FunctionBinding _rangeIself _lefthandsideIself _righthandsideIself + {-# INLINE rule231 #-} + rule231 = \ _self -> + _self + {-# INLINE rule232 #-} + rule232 = \ _oneLineTree -> + _oneLineTree + +-- FunctionBindings -------------------------------------------- +-- wrapper +data Inh_FunctionBindings = Inh_FunctionBindings { } +data Syn_FunctionBindings = Syn_FunctionBindings { oneLineTree_Syn_FunctionBindings :: ( [ OneLineTree] ), self_Syn_FunctionBindings :: (FunctionBindings) } +{-# INLINABLE wrap_FunctionBindings #-} +wrap_FunctionBindings :: T_FunctionBindings -> Inh_FunctionBindings -> (Syn_FunctionBindings ) +wrap_FunctionBindings (T_FunctionBindings act) (Inh_FunctionBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBindings_vIn58 + (T_FunctionBindings_vOut58 _lhsOoneLineTree _lhsOself) <- return (inv_FunctionBindings_s59 sem arg) + return (Syn_FunctionBindings _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_FunctionBindings #-} +sem_FunctionBindings :: FunctionBindings -> T_FunctionBindings +sem_FunctionBindings list = Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list) + +-- semantic domain +newtype T_FunctionBindings = T_FunctionBindings { + attach_T_FunctionBindings :: Identity (T_FunctionBindings_s59 ) + } +newtype T_FunctionBindings_s59 = C_FunctionBindings_s59 { + inv_FunctionBindings_s59 :: (T_FunctionBindings_v58 ) + } +data T_FunctionBindings_s60 = C_FunctionBindings_s60 +type T_FunctionBindings_v58 = (T_FunctionBindings_vIn58 ) -> (T_FunctionBindings_vOut58 ) +data T_FunctionBindings_vIn58 = T_FunctionBindings_vIn58 +data T_FunctionBindings_vOut58 = T_FunctionBindings_vOut58 ( [ OneLineTree] ) (FunctionBindings) +{-# NOINLINE sem_FunctionBindings_Cons #-} +sem_FunctionBindings_Cons :: T_FunctionBinding -> T_FunctionBindings -> T_FunctionBindings +sem_FunctionBindings_Cons arg_hd_ arg_tl_ = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 ) -> ( let + _hdX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_hd_)) + _tlX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_tl_)) + (T_FunctionBinding_vOut55 _hdIoneLineTree _hdIself) = inv_FunctionBinding_s56 _hdX56 (T_FunctionBinding_vIn55 ) + (T_FunctionBindings_vOut58 _tlIoneLineTree _tlIself) = inv_FunctionBindings_s59 _tlX59 (T_FunctionBindings_vIn58 ) + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule233 _hdIoneLineTree _tlIoneLineTree + _self = rule234 _hdIself _tlIself + _lhsOself :: FunctionBindings + _lhsOself = rule235 _self + __result_ = T_FunctionBindings_vOut58 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule233 #-} + rule233 = \ ((_hdIoneLineTree) :: OneLineTree) ((_tlIoneLineTree) :: [ OneLineTree] ) -> + _hdIoneLineTree : _tlIoneLineTree + {-# INLINE rule234 #-} + rule234 = \ ((_hdIself) :: FunctionBinding) ((_tlIself) :: FunctionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule235 #-} + rule235 = \ _self -> + _self +{-# NOINLINE sem_FunctionBindings_Nil #-} +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 ) -> ( let + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule236 () + _self = rule237 () + _lhsOself :: FunctionBindings + _lhsOself = rule238 _self + __result_ = T_FunctionBindings_vOut58 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule236 #-} + rule236 = \ (_ :: ()) -> + [] + {-# INLINE rule237 #-} + rule237 = \ (_ :: ()) -> + [] + {-# INLINE rule238 #-} + rule238 = \ _self -> + _self + +-- GuardedExpression ------------------------------------------- +-- wrapper +data Inh_GuardedExpression = Inh_GuardedExpression { } +data Syn_GuardedExpression = Syn_GuardedExpression { oneLineTree_Syn_GuardedExpression :: ( String -> OneLineTree ), self_Syn_GuardedExpression :: (GuardedExpression) } +{-# INLINABLE wrap_GuardedExpression #-} +wrap_GuardedExpression :: T_GuardedExpression -> Inh_GuardedExpression -> (Syn_GuardedExpression ) +wrap_GuardedExpression (T_GuardedExpression act) (Inh_GuardedExpression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpression_vIn61 + (T_GuardedExpression_vOut61 _lhsOoneLineTree _lhsOself) <- return (inv_GuardedExpression_s62 sem arg) + return (Syn_GuardedExpression _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpression #-} +sem_GuardedExpression :: GuardedExpression -> T_GuardedExpression +sem_GuardedExpression ( GuardedExpression_GuardedExpression range_ guard_ expression_ ) = sem_GuardedExpression_GuardedExpression ( sem_Range range_ ) ( sem_Expression guard_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_GuardedExpression = T_GuardedExpression { + attach_T_GuardedExpression :: Identity (T_GuardedExpression_s62 ) + } +newtype T_GuardedExpression_s62 = C_GuardedExpression_s62 { + inv_GuardedExpression_s62 :: (T_GuardedExpression_v61 ) + } +data T_GuardedExpression_s63 = C_GuardedExpression_s63 +type T_GuardedExpression_v61 = (T_GuardedExpression_vIn61 ) -> (T_GuardedExpression_vOut61 ) +data T_GuardedExpression_vIn61 = T_GuardedExpression_vIn61 +data T_GuardedExpression_vOut61 = T_GuardedExpression_vOut61 ( String -> OneLineTree ) (GuardedExpression) +{-# NOINLINE sem_GuardedExpression_GuardedExpression #-} +sem_GuardedExpression_GuardedExpression :: T_Range -> T_Expression -> T_Expression -> T_GuardedExpression +sem_GuardedExpression_GuardedExpression arg_range_ arg_guard_ arg_expression_ = T_GuardedExpression (return st62) where + {-# NOINLINE st62 #-} + st62 = let + v61 :: T_GuardedExpression_v61 + v61 = \ (T_GuardedExpression_vIn61 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIoneLineTree _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _oneLineTree = rule239 _expressionIoneLineTree _guardIoneLineTree + _self = rule240 _expressionIself _guardIself _rangeIself + _lhsOself :: GuardedExpression + _lhsOself = rule241 _self + _lhsOoneLineTree :: String -> OneLineTree + _lhsOoneLineTree = rule242 _oneLineTree + __result_ = T_GuardedExpression_vOut61 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_GuardedExpression_s62 v61 + {-# INLINE rule239 #-} + rule239 = \ ((_expressionIoneLineTree) :: OneLineTree) ((_guardIoneLineTree) :: OneLineTree) -> + \assign -> OneLineNode [ OneLineText " | ", _guardIoneLineTree, OneLineText assign, _expressionIoneLineTree ] + {-# INLINE rule240 #-} + rule240 = \ ((_expressionIself) :: Expression) ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + GuardedExpression_GuardedExpression _rangeIself _guardIself _expressionIself + {-# INLINE rule241 #-} + rule241 = \ _self -> + _self + {-# INLINE rule242 #-} + rule242 = \ _oneLineTree -> + _oneLineTree + +-- GuardedExpressions ------------------------------------------ +-- wrapper +data Inh_GuardedExpressions = Inh_GuardedExpressions { } +data Syn_GuardedExpressions = Syn_GuardedExpressions { oneLineTree_Syn_GuardedExpressions :: ( [ String -> OneLineTree ] ), self_Syn_GuardedExpressions :: (GuardedExpressions) } +{-# INLINABLE wrap_GuardedExpressions #-} +wrap_GuardedExpressions :: T_GuardedExpressions -> Inh_GuardedExpressions -> (Syn_GuardedExpressions ) +wrap_GuardedExpressions (T_GuardedExpressions act) (Inh_GuardedExpressions ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpressions_vIn64 + (T_GuardedExpressions_vOut64 _lhsOoneLineTree _lhsOself) <- return (inv_GuardedExpressions_s65 sem arg) + return (Syn_GuardedExpressions _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_GuardedExpressions #-} +sem_GuardedExpressions :: GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions list = Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list) + +-- semantic domain +newtype T_GuardedExpressions = T_GuardedExpressions { + attach_T_GuardedExpressions :: Identity (T_GuardedExpressions_s65 ) + } +newtype T_GuardedExpressions_s65 = C_GuardedExpressions_s65 { + inv_GuardedExpressions_s65 :: (T_GuardedExpressions_v64 ) + } +data T_GuardedExpressions_s66 = C_GuardedExpressions_s66 +type T_GuardedExpressions_v64 = (T_GuardedExpressions_vIn64 ) -> (T_GuardedExpressions_vOut64 ) +data T_GuardedExpressions_vIn64 = T_GuardedExpressions_vIn64 +data T_GuardedExpressions_vOut64 = T_GuardedExpressions_vOut64 ( [ String -> OneLineTree ] ) (GuardedExpressions) +{-# NOINLINE sem_GuardedExpressions_Cons #-} +sem_GuardedExpressions_Cons :: T_GuardedExpression -> T_GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions_Cons arg_hd_ arg_tl_ = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 ) -> ( let + _hdX62 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpression (arg_hd_)) + _tlX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_tl_)) + (T_GuardedExpression_vOut61 _hdIoneLineTree _hdIself) = inv_GuardedExpression_s62 _hdX62 (T_GuardedExpression_vIn61 ) + (T_GuardedExpressions_vOut64 _tlIoneLineTree _tlIself) = inv_GuardedExpressions_s65 _tlX65 (T_GuardedExpressions_vIn64 ) + _lhsOoneLineTree :: [ String -> OneLineTree ] + _lhsOoneLineTree = rule243 _hdIoneLineTree _tlIoneLineTree + _self = rule244 _hdIself _tlIself + _lhsOself :: GuardedExpressions + _lhsOself = rule245 _self + __result_ = T_GuardedExpressions_vOut64 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule243 #-} + rule243 = \ ((_hdIoneLineTree) :: String -> OneLineTree ) ((_tlIoneLineTree) :: [ String -> OneLineTree ] ) -> + _hdIoneLineTree : _tlIoneLineTree + {-# INLINE rule244 #-} + rule244 = \ ((_hdIself) :: GuardedExpression) ((_tlIself) :: GuardedExpressions) -> + (:) _hdIself _tlIself + {-# INLINE rule245 #-} + rule245 = \ _self -> + _self +{-# NOINLINE sem_GuardedExpressions_Nil #-} +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 ) -> ( let + _lhsOoneLineTree :: [ String -> OneLineTree ] + _lhsOoneLineTree = rule246 () + _self = rule247 () + _lhsOself :: GuardedExpressions + _lhsOself = rule248 _self + __result_ = T_GuardedExpressions_vOut64 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule246 #-} + rule246 = \ (_ :: ()) -> + [] + {-# INLINE rule247 #-} + rule247 = \ (_ :: ()) -> + [] + {-# INLINE rule248 #-} + rule248 = \ _self -> + _self + +-- Import ------------------------------------------------------ +-- wrapper +data Inh_Import = Inh_Import { } +data Syn_Import = Syn_Import { self_Syn_Import :: (Import) } +{-# INLINABLE wrap_Import #-} +wrap_Import :: T_Import -> Inh_Import -> (Syn_Import ) +wrap_Import (T_Import act) (Inh_Import ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Import_vIn67 + (T_Import_vOut67 _lhsOself) <- return (inv_Import_s68 sem arg) + return (Syn_Import _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Import #-} +sem_Import :: Import -> T_Import +sem_Import ( Import_Variable range_ name_ ) = sem_Import_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Import ( Import_TypeOrClass range_ name_ names_ ) = sem_Import_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Import ( Import_TypeOrClassComplete range_ name_ ) = sem_Import_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Import = T_Import { + attach_T_Import :: Identity (T_Import_s68 ) + } +newtype T_Import_s68 = C_Import_s68 { + inv_Import_s68 :: (T_Import_v67 ) + } +data T_Import_s69 = C_Import_s69 +type T_Import_v67 = (T_Import_vIn67 ) -> (T_Import_vOut67 ) +data T_Import_vIn67 = T_Import_vIn67 +data T_Import_vOut67 = T_Import_vOut67 (Import) +{-# NOINLINE sem_Import_Variable #-} +sem_Import_Variable :: T_Range -> T_Name -> T_Import +sem_Import_Variable arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule249 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule250 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule249 #-} + rule249 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_Variable _rangeIself _nameIself + {-# INLINE rule250 #-} + rule250 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClass #-} +sem_Import_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Import +sem_Import_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesIself) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _self = rule251 _nameIself _namesIself _rangeIself + _lhsOself :: Import + _lhsOself = rule252 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule251 #-} + rule251 = \ ((_nameIself) :: Name) ((_namesIself) :: MaybeNames) ((_rangeIself) :: Range) -> + Import_TypeOrClass _rangeIself _nameIself _namesIself + {-# INLINE rule252 #-} + rule252 = \ _self -> + _self +{-# NOINLINE sem_Import_TypeOrClassComplete #-} +sem_Import_TypeOrClassComplete :: T_Range -> T_Name -> T_Import +sem_Import_TypeOrClassComplete arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule253 _nameIself _rangeIself + _lhsOself :: Import + _lhsOself = rule254 _self + __result_ = T_Import_vOut67 _lhsOself + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule253 #-} + rule253 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Import_TypeOrClassComplete _rangeIself _nameIself + {-# INLINE rule254 #-} + rule254 = \ _self -> + _self + +-- ImportDeclaration ------------------------------------------- +-- wrapper +data Inh_ImportDeclaration = Inh_ImportDeclaration { } +data Syn_ImportDeclaration = Syn_ImportDeclaration { self_Syn_ImportDeclaration :: (ImportDeclaration) } +{-# INLINABLE wrap_ImportDeclaration #-} +wrap_ImportDeclaration :: T_ImportDeclaration -> Inh_ImportDeclaration -> (Syn_ImportDeclaration ) +wrap_ImportDeclaration (T_ImportDeclaration act) (Inh_ImportDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclaration_vIn70 + (T_ImportDeclaration_vOut70 _lhsOself) <- return (inv_ImportDeclaration_s71 sem arg) + return (Syn_ImportDeclaration _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclaration #-} +sem_ImportDeclaration :: ImportDeclaration -> T_ImportDeclaration +sem_ImportDeclaration ( ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ ) = sem_ImportDeclaration_Import ( sem_Range range_ ) qualified_ ( sem_Name name_ ) ( sem_MaybeName asname_ ) ( sem_MaybeImportSpecification importspecification_ ) +sem_ImportDeclaration ( ImportDeclaration_Empty range_ ) = sem_ImportDeclaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_ImportDeclaration = T_ImportDeclaration { + attach_T_ImportDeclaration :: Identity (T_ImportDeclaration_s71 ) + } +newtype T_ImportDeclaration_s71 = C_ImportDeclaration_s71 { + inv_ImportDeclaration_s71 :: (T_ImportDeclaration_v70 ) + } +data T_ImportDeclaration_s72 = C_ImportDeclaration_s72 +type T_ImportDeclaration_v70 = (T_ImportDeclaration_vIn70 ) -> (T_ImportDeclaration_vOut70 ) +data T_ImportDeclaration_vIn70 = T_ImportDeclaration_vIn70 +data T_ImportDeclaration_vOut70 = T_ImportDeclaration_vOut70 (ImportDeclaration) +{-# NOINLINE sem_ImportDeclaration_Import #-} +sem_ImportDeclaration_Import :: T_Range -> (Bool) -> T_Name -> T_MaybeName -> T_MaybeImportSpecification -> T_ImportDeclaration +sem_ImportDeclaration_Import arg_range_ arg_qualified_ arg_name_ arg_asname_ arg_importspecification_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _asnameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_asname_)) + _importspecificationX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeImportSpecification (arg_importspecification_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeName_vOut103 _asnameIself) = inv_MaybeName_s104 _asnameX104 (T_MaybeName_vIn103 ) + (T_MaybeImportSpecification_vOut97 _importspecificationIself) = inv_MaybeImportSpecification_s98 _importspecificationX98 (T_MaybeImportSpecification_vIn97 ) + _self = rule255 _asnameIself _importspecificationIself _nameIself _rangeIself arg_qualified_ + _lhsOself :: ImportDeclaration + _lhsOself = rule256 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule255 #-} + rule255 = \ ((_asnameIself) :: MaybeName) ((_importspecificationIself) :: MaybeImportSpecification) ((_nameIself) :: Name) ((_rangeIself) :: Range) qualified_ -> + ImportDeclaration_Import _rangeIself qualified_ _nameIself _asnameIself _importspecificationIself + {-# INLINE rule256 #-} + rule256 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclaration_Empty #-} +sem_ImportDeclaration_Empty :: T_Range -> T_ImportDeclaration +sem_ImportDeclaration_Empty arg_range_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _self = rule257 _rangeIself + _lhsOself :: ImportDeclaration + _lhsOself = rule258 _self + __result_ = T_ImportDeclaration_vOut70 _lhsOself + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule257 #-} + rule257 = \ ((_rangeIself) :: Range) -> + ImportDeclaration_Empty _rangeIself + {-# INLINE rule258 #-} + rule258 = \ _self -> + _self + +-- ImportDeclarations ------------------------------------------ +-- wrapper +data Inh_ImportDeclarations = Inh_ImportDeclarations { } +data Syn_ImportDeclarations = Syn_ImportDeclarations { self_Syn_ImportDeclarations :: (ImportDeclarations) } +{-# INLINABLE wrap_ImportDeclarations #-} +wrap_ImportDeclarations :: T_ImportDeclarations -> Inh_ImportDeclarations -> (Syn_ImportDeclarations ) +wrap_ImportDeclarations (T_ImportDeclarations act) (Inh_ImportDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclarations_vIn73 + (T_ImportDeclarations_vOut73 _lhsOself) <- return (inv_ImportDeclarations_s74 sem arg) + return (Syn_ImportDeclarations _lhsOself) + ) + +-- cata +{-# NOINLINE sem_ImportDeclarations #-} +sem_ImportDeclarations :: ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations list = Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list) + +-- semantic domain +newtype T_ImportDeclarations = T_ImportDeclarations { + attach_T_ImportDeclarations :: Identity (T_ImportDeclarations_s74 ) + } +newtype T_ImportDeclarations_s74 = C_ImportDeclarations_s74 { + inv_ImportDeclarations_s74 :: (T_ImportDeclarations_v73 ) + } +data T_ImportDeclarations_s75 = C_ImportDeclarations_s75 +type T_ImportDeclarations_v73 = (T_ImportDeclarations_vIn73 ) -> (T_ImportDeclarations_vOut73 ) +data T_ImportDeclarations_vIn73 = T_ImportDeclarations_vIn73 +data T_ImportDeclarations_vOut73 = T_ImportDeclarations_vOut73 (ImportDeclarations) +{-# NOINLINE sem_ImportDeclarations_Cons #-} +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> T_ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations_Cons arg_hd_ arg_tl_ = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _hdX71 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclaration (arg_hd_)) + _tlX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_tl_)) + (T_ImportDeclaration_vOut70 _hdIself) = inv_ImportDeclaration_s71 _hdX71 (T_ImportDeclaration_vIn70 ) + (T_ImportDeclarations_vOut73 _tlIself) = inv_ImportDeclarations_s74 _tlX74 (T_ImportDeclarations_vIn73 ) + _self = rule259 _hdIself _tlIself + _lhsOself :: ImportDeclarations + _lhsOself = rule260 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule259 #-} + rule259 = \ ((_hdIself) :: ImportDeclaration) ((_tlIself) :: ImportDeclarations) -> + (:) _hdIself _tlIself + {-# INLINE rule260 #-} + rule260 = \ _self -> + _self +{-# NOINLINE sem_ImportDeclarations_Nil #-} +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _self = rule261 () + _lhsOself :: ImportDeclarations + _lhsOself = rule262 _self + __result_ = T_ImportDeclarations_vOut73 _lhsOself + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule261 #-} + rule261 = \ (_ :: ()) -> + [] + {-# INLINE rule262 #-} + rule262 = \ _self -> + _self + +-- ImportSpecification ----------------------------------------- +-- wrapper +data Inh_ImportSpecification = Inh_ImportSpecification { } +data Syn_ImportSpecification = Syn_ImportSpecification { self_Syn_ImportSpecification :: (ImportSpecification) } +{-# INLINABLE wrap_ImportSpecification #-} +wrap_ImportSpecification :: T_ImportSpecification -> Inh_ImportSpecification -> (Syn_ImportSpecification ) +wrap_ImportSpecification (T_ImportSpecification act) (Inh_ImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportSpecification_vIn76 + (T_ImportSpecification_vOut76 _lhsOself) <- return (inv_ImportSpecification_s77 sem arg) + return (Syn_ImportSpecification _lhsOself) + ) + +-- cata +{-# INLINE sem_ImportSpecification #-} +sem_ImportSpecification :: ImportSpecification -> T_ImportSpecification +sem_ImportSpecification ( ImportSpecification_Import range_ hiding_ imports_ ) = sem_ImportSpecification_Import ( sem_Range range_ ) hiding_ ( sem_Imports imports_ ) + +-- semantic domain +newtype T_ImportSpecification = T_ImportSpecification { + attach_T_ImportSpecification :: Identity (T_ImportSpecification_s77 ) + } +newtype T_ImportSpecification_s77 = C_ImportSpecification_s77 { + inv_ImportSpecification_s77 :: (T_ImportSpecification_v76 ) + } +data T_ImportSpecification_s78 = C_ImportSpecification_s78 +type T_ImportSpecification_v76 = (T_ImportSpecification_vIn76 ) -> (T_ImportSpecification_vOut76 ) +data T_ImportSpecification_vIn76 = T_ImportSpecification_vIn76 +data T_ImportSpecification_vOut76 = T_ImportSpecification_vOut76 (ImportSpecification) +{-# NOINLINE sem_ImportSpecification_Import #-} +sem_ImportSpecification_Import :: T_Range -> (Bool) -> T_Imports -> T_ImportSpecification +sem_ImportSpecification_Import arg_range_ arg_hiding_ arg_imports_ = T_ImportSpecification (return st77) where + {-# NOINLINE st77 #-} + st77 = let + v76 :: T_ImportSpecification_v76 + v76 = \ (T_ImportSpecification_vIn76 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importsX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_imports_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Imports_vOut79 _importsIself) = inv_Imports_s80 _importsX80 (T_Imports_vIn79 ) + _self = rule263 _importsIself _rangeIself arg_hiding_ + _lhsOself :: ImportSpecification + _lhsOself = rule264 _self + __result_ = T_ImportSpecification_vOut76 _lhsOself + in __result_ ) + in C_ImportSpecification_s77 v76 + {-# INLINE rule263 #-} + rule263 = \ ((_importsIself) :: Imports) ((_rangeIself) :: Range) hiding_ -> + ImportSpecification_Import _rangeIself hiding_ _importsIself + {-# INLINE rule264 #-} + rule264 = \ _self -> + _self + +-- Imports ----------------------------------------------------- +-- wrapper +data Inh_Imports = Inh_Imports { } +data Syn_Imports = Syn_Imports { self_Syn_Imports :: (Imports) } +{-# INLINABLE wrap_Imports #-} +wrap_Imports :: T_Imports -> Inh_Imports -> (Syn_Imports ) +wrap_Imports (T_Imports act) (Inh_Imports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Imports_vIn79 + (T_Imports_vOut79 _lhsOself) <- return (inv_Imports_s80 sem arg) + return (Syn_Imports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Imports #-} +sem_Imports :: Imports -> T_Imports +sem_Imports list = Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list) + +-- semantic domain +newtype T_Imports = T_Imports { + attach_T_Imports :: Identity (T_Imports_s80 ) + } +newtype T_Imports_s80 = C_Imports_s80 { + inv_Imports_s80 :: (T_Imports_v79 ) + } +data T_Imports_s81 = C_Imports_s81 +type T_Imports_v79 = (T_Imports_vIn79 ) -> (T_Imports_vOut79 ) +data T_Imports_vIn79 = T_Imports_vIn79 +data T_Imports_vOut79 = T_Imports_vOut79 (Imports) +{-# NOINLINE sem_Imports_Cons #-} +sem_Imports_Cons :: T_Import -> T_Imports -> T_Imports +sem_Imports_Cons arg_hd_ arg_tl_ = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _hdX68 = Control.Monad.Identity.runIdentity (attach_T_Import (arg_hd_)) + _tlX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_tl_)) + (T_Import_vOut67 _hdIself) = inv_Import_s68 _hdX68 (T_Import_vIn67 ) + (T_Imports_vOut79 _tlIself) = inv_Imports_s80 _tlX80 (T_Imports_vIn79 ) + _self = rule265 _hdIself _tlIself + _lhsOself :: Imports + _lhsOself = rule266 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule265 #-} + rule265 = \ ((_hdIself) :: Import) ((_tlIself) :: Imports) -> + (:) _hdIself _tlIself + {-# INLINE rule266 #-} + rule266 = \ _self -> + _self +{-# NOINLINE sem_Imports_Nil #-} +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _self = rule267 () + _lhsOself :: Imports + _lhsOself = rule268 _self + __result_ = T_Imports_vOut79 _lhsOself + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule267 #-} + rule267 = \ (_ :: ()) -> + [] + {-# INLINE rule268 #-} + rule268 = \ _self -> + _self + +-- LeftHandSide ------------------------------------------------ +-- wrapper +data Inh_LeftHandSide = Inh_LeftHandSide { } +data Syn_LeftHandSide = Syn_LeftHandSide { oneLineTree_Syn_LeftHandSide :: (OneLineTree), self_Syn_LeftHandSide :: (LeftHandSide) } +{-# INLINABLE wrap_LeftHandSide #-} +wrap_LeftHandSide :: T_LeftHandSide -> Inh_LeftHandSide -> (Syn_LeftHandSide ) +wrap_LeftHandSide (T_LeftHandSide act) (Inh_LeftHandSide ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_LeftHandSide_vIn82 + (T_LeftHandSide_vOut82 _lhsOoneLineTree _lhsOself) <- return (inv_LeftHandSide_s83 sem arg) + return (Syn_LeftHandSide _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_LeftHandSide #-} +sem_LeftHandSide :: LeftHandSide -> T_LeftHandSide +sem_LeftHandSide ( LeftHandSide_Function range_ name_ patterns_ ) = sem_LeftHandSide_Function ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_LeftHandSide ( LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ ) = sem_LeftHandSide_Infix ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name operator_ ) ( sem_Pattern rightPattern_ ) +sem_LeftHandSide ( LeftHandSide_Parenthesized range_ lefthandside_ patterns_ ) = sem_LeftHandSide_Parenthesized ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_Patterns patterns_ ) + +-- semantic domain +newtype T_LeftHandSide = T_LeftHandSide { + attach_T_LeftHandSide :: Identity (T_LeftHandSide_s83 ) + } +newtype T_LeftHandSide_s83 = C_LeftHandSide_s83 { + inv_LeftHandSide_s83 :: (T_LeftHandSide_v82 ) + } +data T_LeftHandSide_s84 = C_LeftHandSide_s84 +type T_LeftHandSide_v82 = (T_LeftHandSide_vIn82 ) -> (T_LeftHandSide_vOut82 ) +data T_LeftHandSide_vIn82 = T_LeftHandSide_vIn82 +data T_LeftHandSide_vOut82 = T_LeftHandSide_vOut82 (OneLineTree) (LeftHandSide) +{-# NOINLINE sem_LeftHandSide_Function #-} +sem_LeftHandSide_Function :: T_Range -> T_Name -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Function arg_range_ arg_name_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIoneLineTree _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _oneLineTree = rule269 _nameIoneLineTree _patternsIoneLineTree + _self = rule270 _nameIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule271 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule272 _oneLineTree + __result_ = T_LeftHandSide_vOut82 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule269 #-} + rule269 = \ ((_nameIoneLineTree) :: OneLineTree) ((_patternsIoneLineTree) :: [ OneLineTree] ) -> + punctuate " " (_nameIoneLineTree : _patternsIoneLineTree) + {-# INLINE rule270 #-} + rule270 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Function _rangeIself _nameIself _patternsIself + {-# INLINE rule271 #-} + rule271 = \ _self -> + _self + {-# INLINE rule272 #-} + rule272 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_LeftHandSide_Infix #-} +sem_LeftHandSide_Infix :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_LeftHandSide +sem_LeftHandSide_Infix arg_range_ arg_leftPattern_ arg_operator_ arg_rightPattern_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _operatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_operator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIoneLineTree _leftPatternIself) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 ) + (T_Name_vOut112 _operatorIisIdentifier _operatorIisOperator _operatorIisSpecial _operatorIoneLineTree _operatorIself) = inv_Name_s113 _operatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIoneLineTree _rightPatternIself) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 ) + _operatorName = rule273 _operatorIoneLineTree + _oneLineTree = rule274 _leftPatternIoneLineTree _operatorName _rightPatternIoneLineTree + _self = rule275 _leftPatternIself _operatorIself _rangeIself _rightPatternIself + _lhsOself :: LeftHandSide + _lhsOself = rule276 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule277 _oneLineTree + __result_ = T_LeftHandSide_vOut82 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule273 #-} + rule273 = \ ((_operatorIoneLineTree) :: OneLineTree) -> + oneLineTreeAsOperator _operatorIoneLineTree + {-# INLINE rule274 #-} + rule274 = \ ((_leftPatternIoneLineTree) :: OneLineTree) _operatorName ((_rightPatternIoneLineTree) :: OneLineTree) -> + punctuate " " [_leftPatternIoneLineTree, _operatorName, _rightPatternIoneLineTree] + {-# INLINE rule275 #-} + rule275 = \ ((_leftPatternIself) :: Pattern) ((_operatorIself) :: Name) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + LeftHandSide_Infix _rangeIself _leftPatternIself _operatorIself _rightPatternIself + {-# INLINE rule276 #-} + rule276 = \ _self -> + _self + {-# INLINE rule277 #-} + rule277 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_LeftHandSide_Parenthesized #-} +sem_LeftHandSide_Parenthesized :: T_Range -> T_LeftHandSide -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Parenthesized arg_range_ arg_lefthandside_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideIoneLineTree _lefthandsideIself) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 ) + (T_Patterns_vOut121 _patternsIoneLineTree _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _oneLineTree = rule278 _lefthandsideIoneLineTree _patternsIoneLineTree + _self = rule279 _lefthandsideIself _patternsIself _rangeIself + _lhsOself :: LeftHandSide + _lhsOself = rule280 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule281 _oneLineTree + __result_ = T_LeftHandSide_vOut82 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule278 #-} + rule278 = \ ((_lefthandsideIoneLineTree) :: OneLineTree) ((_patternsIoneLineTree) :: [ OneLineTree] ) -> + punctuate " " ( parens _lefthandsideIoneLineTree : _patternsIoneLineTree ) + {-# INLINE rule279 #-} + rule279 = \ ((_lefthandsideIself) :: LeftHandSide) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + LeftHandSide_Parenthesized _rangeIself _lefthandsideIself _patternsIself + {-# INLINE rule280 #-} + rule280 = \ _self -> + _self + {-# INLINE rule281 #-} + rule281 = \ _oneLineTree -> + _oneLineTree + +-- Literal ----------------------------------------------------- +-- wrapper +data Inh_Literal = Inh_Literal { } +data Syn_Literal = Syn_Literal { oneLineTree_Syn_Literal :: (OneLineTree), self_Syn_Literal :: (Literal) } +{-# INLINABLE wrap_Literal #-} +wrap_Literal :: T_Literal -> Inh_Literal -> (Syn_Literal ) +wrap_Literal (T_Literal act) (Inh_Literal ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Literal_vIn85 + (T_Literal_vOut85 _lhsOoneLineTree _lhsOself) <- return (inv_Literal_s86 sem arg) + return (Syn_Literal _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Literal #-} +sem_Literal :: Literal -> T_Literal +sem_Literal ( Literal_Int range_ value_ ) = sem_Literal_Int ( sem_Range range_ ) value_ +sem_Literal ( Literal_Char range_ value_ ) = sem_Literal_Char ( sem_Range range_ ) value_ +sem_Literal ( Literal_Float range_ value_ ) = sem_Literal_Float ( sem_Range range_ ) value_ +sem_Literal ( Literal_String range_ value_ ) = sem_Literal_String ( sem_Range range_ ) value_ + +-- semantic domain +newtype T_Literal = T_Literal { + attach_T_Literal :: Identity (T_Literal_s86 ) + } +newtype T_Literal_s86 = C_Literal_s86 { + inv_Literal_s86 :: (T_Literal_v85 ) + } +data T_Literal_s87 = C_Literal_s87 +type T_Literal_v85 = (T_Literal_vIn85 ) -> (T_Literal_vOut85 ) +data T_Literal_vIn85 = T_Literal_vIn85 +data T_Literal_vOut85 = T_Literal_vOut85 (OneLineTree) (Literal) +{-# NOINLINE sem_Literal_Int #-} +sem_Literal_Int :: T_Range -> (String) -> T_Literal +sem_Literal_Int arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule282 arg_value_ + _self = rule283 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule284 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule285 _oneLineTree + __result_ = T_Literal_vOut85 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule282 #-} + rule282 = \ value_ -> + OneLineText value_ + {-# INLINE rule283 #-} + rule283 = \ ((_rangeIself) :: Range) value_ -> + Literal_Int _rangeIself value_ + {-# INLINE rule284 #-} + rule284 = \ _self -> + _self + {-# INLINE rule285 #-} + rule285 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Literal_Char #-} +sem_Literal_Char :: T_Range -> (String) -> T_Literal +sem_Literal_Char arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule286 arg_value_ + _self = rule287 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule288 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule289 _oneLineTree + __result_ = T_Literal_vOut85 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule286 #-} + rule286 = \ value_ -> + OneLineText ("'" ++ value_ ++ "'") + {-# INLINE rule287 #-} + rule287 = \ ((_rangeIself) :: Range) value_ -> + Literal_Char _rangeIself value_ + {-# INLINE rule288 #-} + rule288 = \ _self -> + _self + {-# INLINE rule289 #-} + rule289 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Literal_Float #-} +sem_Literal_Float :: T_Range -> (String) -> T_Literal +sem_Literal_Float arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule290 arg_value_ + _self = rule291 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule292 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule293 _oneLineTree + __result_ = T_Literal_vOut85 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule290 #-} + rule290 = \ value_ -> + OneLineText value_ + {-# INLINE rule291 #-} + rule291 = \ ((_rangeIself) :: Range) value_ -> + Literal_Float _rangeIself value_ + {-# INLINE rule292 #-} + rule292 = \ _self -> + _self + {-# INLINE rule293 #-} + rule293 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Literal_String #-} +sem_Literal_String :: T_Range -> (String) -> T_Literal +sem_Literal_String arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule294 arg_value_ + _self = rule295 _rangeIself arg_value_ + _lhsOself :: Literal + _lhsOself = rule296 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule297 _oneLineTree + __result_ = T_Literal_vOut85 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule294 #-} + rule294 = \ value_ -> + OneLineText ("\"" ++ value_ ++ "\"") + {-# INLINE rule295 #-} + rule295 = \ ((_rangeIself) :: Range) value_ -> + Literal_String _rangeIself value_ + {-# INLINE rule296 #-} + rule296 = \ _self -> + _self + {-# INLINE rule297 #-} + rule297 = \ _oneLineTree -> + _oneLineTree + +-- MaybeDeclarations ------------------------------------------- +-- wrapper +data Inh_MaybeDeclarations = Inh_MaybeDeclarations { } +data Syn_MaybeDeclarations = Syn_MaybeDeclarations { oneLineTree_Syn_MaybeDeclarations :: ( Maybe [OneLineTree] ), self_Syn_MaybeDeclarations :: (MaybeDeclarations) } +{-# INLINABLE wrap_MaybeDeclarations #-} +wrap_MaybeDeclarations :: T_MaybeDeclarations -> Inh_MaybeDeclarations -> (Syn_MaybeDeclarations ) +wrap_MaybeDeclarations (T_MaybeDeclarations act) (Inh_MaybeDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeDeclarations_vIn88 + (T_MaybeDeclarations_vOut88 _lhsOoneLineTree _lhsOself) <- return (inv_MaybeDeclarations_s89 sem arg) + return (Syn_MaybeDeclarations _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeDeclarations #-} +sem_MaybeDeclarations :: MaybeDeclarations -> T_MaybeDeclarations +sem_MaybeDeclarations ( MaybeDeclarations_Nothing ) = sem_MaybeDeclarations_Nothing +sem_MaybeDeclarations ( MaybeDeclarations_Just declarations_ ) = sem_MaybeDeclarations_Just ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_MaybeDeclarations = T_MaybeDeclarations { + attach_T_MaybeDeclarations :: Identity (T_MaybeDeclarations_s89 ) + } +newtype T_MaybeDeclarations_s89 = C_MaybeDeclarations_s89 { + inv_MaybeDeclarations_s89 :: (T_MaybeDeclarations_v88 ) + } +data T_MaybeDeclarations_s90 = C_MaybeDeclarations_s90 +type T_MaybeDeclarations_v88 = (T_MaybeDeclarations_vIn88 ) -> (T_MaybeDeclarations_vOut88 ) +data T_MaybeDeclarations_vIn88 = T_MaybeDeclarations_vIn88 +data T_MaybeDeclarations_vOut88 = T_MaybeDeclarations_vOut88 ( Maybe [OneLineTree] ) (MaybeDeclarations) +{-# NOINLINE sem_MaybeDeclarations_Nothing #-} +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 ) -> ( let + _oneLineTree = rule298 () + _self = rule299 () + _lhsOself :: MaybeDeclarations + _lhsOself = rule300 _self + _lhsOoneLineTree :: Maybe [OneLineTree] + _lhsOoneLineTree = rule301 _oneLineTree + __result_ = T_MaybeDeclarations_vOut88 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule298 #-} + rule298 = \ (_ :: ()) -> + Nothing + {-# INLINE rule299 #-} + rule299 = \ (_ :: ()) -> + MaybeDeclarations_Nothing + {-# INLINE rule300 #-} + rule300 = \ _self -> + _self + {-# INLINE rule301 #-} + rule301 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_MaybeDeclarations_Just #-} +sem_MaybeDeclarations_Just :: T_Declarations -> T_MaybeDeclarations +sem_MaybeDeclarations_Just arg_declarations_ = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 ) -> ( let + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Declarations_vOut31 _declarationsIoneLineTree _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _oneLineTree = rule302 _declarationsIoneLineTree + _self = rule303 _declarationsIself + _lhsOself :: MaybeDeclarations + _lhsOself = rule304 _self + _lhsOoneLineTree :: Maybe [OneLineTree] + _lhsOoneLineTree = rule305 _oneLineTree + __result_ = T_MaybeDeclarations_vOut88 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule302 #-} + rule302 = \ ((_declarationsIoneLineTree) :: [ OneLineTree] ) -> + Just _declarationsIoneLineTree + {-# INLINE rule303 #-} + rule303 = \ ((_declarationsIself) :: Declarations) -> + MaybeDeclarations_Just _declarationsIself + {-# INLINE rule304 #-} + rule304 = \ _self -> + _self + {-# INLINE rule305 #-} + rule305 = \ _oneLineTree -> + _oneLineTree + +-- MaybeExports ------------------------------------------------ +-- wrapper +data Inh_MaybeExports = Inh_MaybeExports { } +data Syn_MaybeExports = Syn_MaybeExports { self_Syn_MaybeExports :: (MaybeExports) } +{-# INLINABLE wrap_MaybeExports #-} +wrap_MaybeExports :: T_MaybeExports -> Inh_MaybeExports -> (Syn_MaybeExports ) +wrap_MaybeExports (T_MaybeExports act) (Inh_MaybeExports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExports_vIn91 + (T_MaybeExports_vOut91 _lhsOself) <- return (inv_MaybeExports_s92 sem arg) + return (Syn_MaybeExports _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExports #-} +sem_MaybeExports :: MaybeExports -> T_MaybeExports +sem_MaybeExports ( MaybeExports_Nothing ) = sem_MaybeExports_Nothing +sem_MaybeExports ( MaybeExports_Just exports_ ) = sem_MaybeExports_Just ( sem_Exports exports_ ) + +-- semantic domain +newtype T_MaybeExports = T_MaybeExports { + attach_T_MaybeExports :: Identity (T_MaybeExports_s92 ) + } +newtype T_MaybeExports_s92 = C_MaybeExports_s92 { + inv_MaybeExports_s92 :: (T_MaybeExports_v91 ) + } +data T_MaybeExports_s93 = C_MaybeExports_s93 +type T_MaybeExports_v91 = (T_MaybeExports_vIn91 ) -> (T_MaybeExports_vOut91 ) +data T_MaybeExports_vIn91 = T_MaybeExports_vIn91 +data T_MaybeExports_vOut91 = T_MaybeExports_vOut91 (MaybeExports) +{-# NOINLINE sem_MaybeExports_Nothing #-} +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _self = rule306 () + _lhsOself :: MaybeExports + _lhsOself = rule307 _self + __result_ = T_MaybeExports_vOut91 _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule306 #-} + rule306 = \ (_ :: ()) -> + MaybeExports_Nothing + {-# INLINE rule307 #-} + rule307 = \ _self -> + _self +{-# NOINLINE sem_MaybeExports_Just #-} +sem_MaybeExports_Just :: T_Exports -> T_MaybeExports +sem_MaybeExports_Just arg_exports_ = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _exportsX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_exports_)) + (T_Exports_vOut37 _exportsIself) = inv_Exports_s38 _exportsX38 (T_Exports_vIn37 ) + _self = rule308 _exportsIself + _lhsOself :: MaybeExports + _lhsOself = rule309 _self + __result_ = T_MaybeExports_vOut91 _lhsOself + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule308 #-} + rule308 = \ ((_exportsIself) :: Exports) -> + MaybeExports_Just _exportsIself + {-# INLINE rule309 #-} + rule309 = \ _self -> + _self + +-- MaybeExpression --------------------------------------------- +-- wrapper +data Inh_MaybeExpression = Inh_MaybeExpression { } +data Syn_MaybeExpression = Syn_MaybeExpression { oneLineTree_Syn_MaybeExpression :: ( Maybe OneLineTree ), self_Syn_MaybeExpression :: (MaybeExpression) } +{-# INLINABLE wrap_MaybeExpression #-} +wrap_MaybeExpression :: T_MaybeExpression -> Inh_MaybeExpression -> (Syn_MaybeExpression ) +wrap_MaybeExpression (T_MaybeExpression act) (Inh_MaybeExpression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExpression_vIn94 + (T_MaybeExpression_vOut94 _lhsOoneLineTree _lhsOself) <- return (inv_MaybeExpression_s95 sem arg) + return (Syn_MaybeExpression _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeExpression #-} +sem_MaybeExpression :: MaybeExpression -> T_MaybeExpression +sem_MaybeExpression ( MaybeExpression_Nothing ) = sem_MaybeExpression_Nothing +sem_MaybeExpression ( MaybeExpression_Just expression_ ) = sem_MaybeExpression_Just ( sem_Expression expression_ ) + +-- semantic domain +newtype T_MaybeExpression = T_MaybeExpression { + attach_T_MaybeExpression :: Identity (T_MaybeExpression_s95 ) + } +newtype T_MaybeExpression_s95 = C_MaybeExpression_s95 { + inv_MaybeExpression_s95 :: (T_MaybeExpression_v94 ) + } +data T_MaybeExpression_s96 = C_MaybeExpression_s96 +type T_MaybeExpression_v94 = (T_MaybeExpression_vIn94 ) -> (T_MaybeExpression_vOut94 ) +data T_MaybeExpression_vIn94 = T_MaybeExpression_vIn94 +data T_MaybeExpression_vOut94 = T_MaybeExpression_vOut94 ( Maybe OneLineTree ) (MaybeExpression) +{-# NOINLINE sem_MaybeExpression_Nothing #-} +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 ) -> ( let + _oneLineTree = rule310 () + _self = rule311 () + _lhsOself :: MaybeExpression + _lhsOself = rule312 _self + _lhsOoneLineTree :: Maybe OneLineTree + _lhsOoneLineTree = rule313 _oneLineTree + __result_ = T_MaybeExpression_vOut94 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule310 #-} + rule310 = \ (_ :: ()) -> + Nothing + {-# INLINE rule311 #-} + rule311 = \ (_ :: ()) -> + MaybeExpression_Nothing + {-# INLINE rule312 #-} + rule312 = \ _self -> + _self + {-# INLINE rule313 #-} + rule313 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_MaybeExpression_Just #-} +sem_MaybeExpression_Just :: T_Expression -> T_MaybeExpression +sem_MaybeExpression_Just arg_expression_ = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 ) -> ( let + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _oneLineTree = rule314 _expressionIoneLineTree + _self = rule315 _expressionIself + _lhsOself :: MaybeExpression + _lhsOself = rule316 _self + _lhsOoneLineTree :: Maybe OneLineTree + _lhsOoneLineTree = rule317 _oneLineTree + __result_ = T_MaybeExpression_vOut94 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule314 #-} + rule314 = \ ((_expressionIoneLineTree) :: OneLineTree) -> + Just _expressionIoneLineTree + {-# INLINE rule315 #-} + rule315 = \ ((_expressionIself) :: Expression) -> + MaybeExpression_Just _expressionIself + {-# INLINE rule316 #-} + rule316 = \ _self -> + _self + {-# INLINE rule317 #-} + rule317 = \ _oneLineTree -> + _oneLineTree + +-- MaybeImportSpecification ------------------------------------ +-- wrapper +data Inh_MaybeImportSpecification = Inh_MaybeImportSpecification { } +data Syn_MaybeImportSpecification = Syn_MaybeImportSpecification { self_Syn_MaybeImportSpecification :: (MaybeImportSpecification) } +{-# INLINABLE wrap_MaybeImportSpecification #-} +wrap_MaybeImportSpecification :: T_MaybeImportSpecification -> Inh_MaybeImportSpecification -> (Syn_MaybeImportSpecification ) +wrap_MaybeImportSpecification (T_MaybeImportSpecification act) (Inh_MaybeImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeImportSpecification_vIn97 + (T_MaybeImportSpecification_vOut97 _lhsOself) <- return (inv_MaybeImportSpecification_s98 sem arg) + return (Syn_MaybeImportSpecification _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeImportSpecification #-} +sem_MaybeImportSpecification :: MaybeImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification ( MaybeImportSpecification_Nothing ) = sem_MaybeImportSpecification_Nothing +sem_MaybeImportSpecification ( MaybeImportSpecification_Just importspecification_ ) = sem_MaybeImportSpecification_Just ( sem_ImportSpecification importspecification_ ) + +-- semantic domain +newtype T_MaybeImportSpecification = T_MaybeImportSpecification { + attach_T_MaybeImportSpecification :: Identity (T_MaybeImportSpecification_s98 ) + } +newtype T_MaybeImportSpecification_s98 = C_MaybeImportSpecification_s98 { + inv_MaybeImportSpecification_s98 :: (T_MaybeImportSpecification_v97 ) + } +data T_MaybeImportSpecification_s99 = C_MaybeImportSpecification_s99 +type T_MaybeImportSpecification_v97 = (T_MaybeImportSpecification_vIn97 ) -> (T_MaybeImportSpecification_vOut97 ) +data T_MaybeImportSpecification_vIn97 = T_MaybeImportSpecification_vIn97 +data T_MaybeImportSpecification_vOut97 = T_MaybeImportSpecification_vOut97 (MaybeImportSpecification) +{-# NOINLINE sem_MaybeImportSpecification_Nothing #-} +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _self = rule318 () + _lhsOself :: MaybeImportSpecification + _lhsOself = rule319 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule318 #-} + rule318 = \ (_ :: ()) -> + MaybeImportSpecification_Nothing + {-# INLINE rule319 #-} + rule319 = \ _self -> + _self +{-# NOINLINE sem_MaybeImportSpecification_Just #-} +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification_Just arg_importspecification_ = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _importspecificationX77 = Control.Monad.Identity.runIdentity (attach_T_ImportSpecification (arg_importspecification_)) + (T_ImportSpecification_vOut76 _importspecificationIself) = inv_ImportSpecification_s77 _importspecificationX77 (T_ImportSpecification_vIn76 ) + _self = rule320 _importspecificationIself + _lhsOself :: MaybeImportSpecification + _lhsOself = rule321 _self + __result_ = T_MaybeImportSpecification_vOut97 _lhsOself + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule320 #-} + rule320 = \ ((_importspecificationIself) :: ImportSpecification) -> + MaybeImportSpecification_Just _importspecificationIself + {-# INLINE rule321 #-} + rule321 = \ _self -> + _self + +-- MaybeInt ---------------------------------------------------- +-- wrapper +data Inh_MaybeInt = Inh_MaybeInt { } +data Syn_MaybeInt = Syn_MaybeInt { self_Syn_MaybeInt :: (MaybeInt) } +{-# INLINABLE wrap_MaybeInt #-} +wrap_MaybeInt :: T_MaybeInt -> Inh_MaybeInt -> (Syn_MaybeInt ) +wrap_MaybeInt (T_MaybeInt act) (Inh_MaybeInt ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeInt_vIn100 + (T_MaybeInt_vOut100 _lhsOself) <- return (inv_MaybeInt_s101 sem arg) + return (Syn_MaybeInt _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeInt #-} +sem_MaybeInt :: MaybeInt -> T_MaybeInt +sem_MaybeInt ( MaybeInt_Nothing ) = sem_MaybeInt_Nothing +sem_MaybeInt ( MaybeInt_Just int_ ) = sem_MaybeInt_Just int_ + +-- semantic domain +newtype T_MaybeInt = T_MaybeInt { + attach_T_MaybeInt :: Identity (T_MaybeInt_s101 ) + } +newtype T_MaybeInt_s101 = C_MaybeInt_s101 { + inv_MaybeInt_s101 :: (T_MaybeInt_v100 ) + } +data T_MaybeInt_s102 = C_MaybeInt_s102 +type T_MaybeInt_v100 = (T_MaybeInt_vIn100 ) -> (T_MaybeInt_vOut100 ) +data T_MaybeInt_vIn100 = T_MaybeInt_vIn100 +data T_MaybeInt_vOut100 = T_MaybeInt_vOut100 (MaybeInt) +{-# NOINLINE sem_MaybeInt_Nothing #-} +sem_MaybeInt_Nothing :: T_MaybeInt +sem_MaybeInt_Nothing = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule322 () + _lhsOself :: MaybeInt + _lhsOself = rule323 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule322 #-} + rule322 = \ (_ :: ()) -> + MaybeInt_Nothing + {-# INLINE rule323 #-} + rule323 = \ _self -> + _self +{-# NOINLINE sem_MaybeInt_Just #-} +sem_MaybeInt_Just :: (Int) -> T_MaybeInt +sem_MaybeInt_Just arg_int_ = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _self = rule324 arg_int_ + _lhsOself :: MaybeInt + _lhsOself = rule325 _self + __result_ = T_MaybeInt_vOut100 _lhsOself + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule324 #-} + rule324 = \ int_ -> + MaybeInt_Just int_ + {-# INLINE rule325 #-} + rule325 = \ _self -> + _self + +-- MaybeName --------------------------------------------------- +-- wrapper +data Inh_MaybeName = Inh_MaybeName { } +data Syn_MaybeName = Syn_MaybeName { self_Syn_MaybeName :: (MaybeName) } +{-# INLINABLE wrap_MaybeName #-} +wrap_MaybeName :: T_MaybeName -> Inh_MaybeName -> (Syn_MaybeName ) +wrap_MaybeName (T_MaybeName act) (Inh_MaybeName ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeName_vIn103 + (T_MaybeName_vOut103 _lhsOself) <- return (inv_MaybeName_s104 sem arg) + return (Syn_MaybeName _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeName #-} +sem_MaybeName :: MaybeName -> T_MaybeName +sem_MaybeName ( MaybeName_Nothing ) = sem_MaybeName_Nothing +sem_MaybeName ( MaybeName_Just name_ ) = sem_MaybeName_Just ( sem_Name name_ ) + +-- semantic domain +newtype T_MaybeName = T_MaybeName { + attach_T_MaybeName :: Identity (T_MaybeName_s104 ) + } +newtype T_MaybeName_s104 = C_MaybeName_s104 { + inv_MaybeName_s104 :: (T_MaybeName_v103 ) + } +data T_MaybeName_s105 = C_MaybeName_s105 +type T_MaybeName_v103 = (T_MaybeName_vIn103 ) -> (T_MaybeName_vOut103 ) +data T_MaybeName_vIn103 = T_MaybeName_vIn103 +data T_MaybeName_vOut103 = T_MaybeName_vOut103 (MaybeName) +{-# NOINLINE sem_MaybeName_Nothing #-} +sem_MaybeName_Nothing :: T_MaybeName +sem_MaybeName_Nothing = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _self = rule326 () + _lhsOself :: MaybeName + _lhsOself = rule327 _self + __result_ = T_MaybeName_vOut103 _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule326 #-} + rule326 = \ (_ :: ()) -> + MaybeName_Nothing + {-# INLINE rule327 #-} + rule327 = \ _self -> + _self +{-# NOINLINE sem_MaybeName_Just #-} +sem_MaybeName_Just :: T_Name -> T_MaybeName +sem_MaybeName_Just arg_name_ = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule328 _nameIself + _lhsOself :: MaybeName + _lhsOself = rule329 _self + __result_ = T_MaybeName_vOut103 _lhsOself + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule328 #-} + rule328 = \ ((_nameIself) :: Name) -> + MaybeName_Just _nameIself + {-# INLINE rule329 #-} + rule329 = \ _self -> + _self + +-- MaybeNames -------------------------------------------------- +-- wrapper +data Inh_MaybeNames = Inh_MaybeNames { } +data Syn_MaybeNames = Syn_MaybeNames { self_Syn_MaybeNames :: (MaybeNames) } +{-# INLINABLE wrap_MaybeNames #-} +wrap_MaybeNames :: T_MaybeNames -> Inh_MaybeNames -> (Syn_MaybeNames ) +wrap_MaybeNames (T_MaybeNames act) (Inh_MaybeNames ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeNames_vIn106 + (T_MaybeNames_vOut106 _lhsOself) <- return (inv_MaybeNames_s107 sem arg) + return (Syn_MaybeNames _lhsOself) + ) + +-- cata +{-# NOINLINE sem_MaybeNames #-} +sem_MaybeNames :: MaybeNames -> T_MaybeNames +sem_MaybeNames ( MaybeNames_Nothing ) = sem_MaybeNames_Nothing +sem_MaybeNames ( MaybeNames_Just names_ ) = sem_MaybeNames_Just ( sem_Names names_ ) + +-- semantic domain +newtype T_MaybeNames = T_MaybeNames { + attach_T_MaybeNames :: Identity (T_MaybeNames_s107 ) + } +newtype T_MaybeNames_s107 = C_MaybeNames_s107 { + inv_MaybeNames_s107 :: (T_MaybeNames_v106 ) + } +data T_MaybeNames_s108 = C_MaybeNames_s108 +type T_MaybeNames_v106 = (T_MaybeNames_vIn106 ) -> (T_MaybeNames_vOut106 ) +data T_MaybeNames_vIn106 = T_MaybeNames_vIn106 +data T_MaybeNames_vOut106 = T_MaybeNames_vOut106 (MaybeNames) +{-# NOINLINE sem_MaybeNames_Nothing #-} +sem_MaybeNames_Nothing :: T_MaybeNames +sem_MaybeNames_Nothing = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _self = rule330 () + _lhsOself :: MaybeNames + _lhsOself = rule331 _self + __result_ = T_MaybeNames_vOut106 _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule330 #-} + rule330 = \ (_ :: ()) -> + MaybeNames_Nothing + {-# INLINE rule331 #-} + rule331 = \ _self -> + _self +{-# NOINLINE sem_MaybeNames_Just #-} +sem_MaybeNames_Just :: T_Names -> T_MaybeNames +sem_MaybeNames_Just arg_names_ = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + (T_Names_vOut115 _namesIisIdentifier _namesIisOperator _namesIisSpecial _namesIoneLineTree _namesIself) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + _self = rule332 _namesIself + _lhsOself :: MaybeNames + _lhsOself = rule333 _self + __result_ = T_MaybeNames_vOut106 _lhsOself + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule332 #-} + rule332 = \ ((_namesIself) :: Names) -> + MaybeNames_Just _namesIself + {-# INLINE rule333 #-} + rule333 = \ _self -> + _self + +-- Module ------------------------------------------------------ +-- wrapper +data Inh_Module = Inh_Module { } +data Syn_Module = Syn_Module { self_Syn_Module :: (Module) } +{-# INLINABLE wrap_Module #-} +wrap_Module :: T_Module -> Inh_Module -> (Syn_Module ) +wrap_Module (T_Module act) (Inh_Module ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Module_vIn109 + (T_Module_vOut109 _lhsOself) <- return (inv_Module_s110 sem arg) + return (Syn_Module _lhsOself) + ) + +-- cata +{-# INLINE sem_Module #-} +sem_Module :: Module -> T_Module +sem_Module ( Module_Module range_ name_ exports_ body_ ) = sem_Module_Module ( sem_Range range_ ) ( sem_MaybeName name_ ) ( sem_MaybeExports exports_ ) ( sem_Body body_ ) + +-- semantic domain +newtype T_Module = T_Module { + attach_T_Module :: Identity (T_Module_s110 ) + } +newtype T_Module_s110 = C_Module_s110 { + inv_Module_s110 :: (T_Module_v109 ) + } +data T_Module_s111 = C_Module_s111 +type T_Module_v109 = (T_Module_vIn109 ) -> (T_Module_vOut109 ) +data T_Module_vIn109 = T_Module_vIn109 +data T_Module_vOut109 = T_Module_vOut109 (Module) +{-# NOINLINE sem_Module_Module #-} +sem_Module_Module :: T_Range -> T_MaybeName -> T_MaybeExports -> T_Body -> T_Module +sem_Module_Module arg_range_ arg_name_ arg_exports_ arg_body_ = T_Module (return st110) where + {-# NOINLINE st110 #-} + st110 = let + v109 :: T_Module_v109 + v109 = \ (T_Module_vIn109 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_name_)) + _exportsX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeExports (arg_exports_)) + _bodyX14 = Control.Monad.Identity.runIdentity (attach_T_Body (arg_body_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeName_vOut103 _nameIself) = inv_MaybeName_s104 _nameX104 (T_MaybeName_vIn103 ) + (T_MaybeExports_vOut91 _exportsIself) = inv_MaybeExports_s92 _exportsX92 (T_MaybeExports_vIn91 ) + (T_Body_vOut13 _bodyIself) = inv_Body_s14 _bodyX14 (T_Body_vIn13 ) + _self = rule334 _bodyIself _exportsIself _nameIself _rangeIself + _lhsOself :: Module + _lhsOself = rule335 _self + __result_ = T_Module_vOut109 _lhsOself + in __result_ ) + in C_Module_s110 v109 + {-# INLINE rule334 #-} + rule334 = \ ((_bodyIself) :: Body) ((_exportsIself) :: MaybeExports) ((_nameIself) :: MaybeName) ((_rangeIself) :: Range) -> + Module_Module _rangeIself _nameIself _exportsIself _bodyIself + {-# INLINE rule335 #-} + rule335 = \ _self -> + _self + +-- Name -------------------------------------------------------- +-- wrapper +data Inh_Name = Inh_Name { } +data Syn_Name = Syn_Name { isIdentifier_Syn_Name :: (Bool), isOperator_Syn_Name :: (Bool), isSpecial_Syn_Name :: (Bool), oneLineTree_Syn_Name :: (OneLineTree), self_Syn_Name :: (Name) } +{-# INLINABLE wrap_Name #-} +wrap_Name :: T_Name -> Inh_Name -> (Syn_Name ) +wrap_Name (T_Name act) (Inh_Name ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Name_vIn112 + (T_Name_vOut112 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOoneLineTree _lhsOself) <- return (inv_Name_s113 sem arg) + return (Syn_Name _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Name #-} +sem_Name :: Name -> T_Name +sem_Name ( Name_Identifier range_ module_ name_ ) = sem_Name_Identifier ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Operator range_ module_ name_ ) = sem_Name_Operator ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Special range_ module_ name_ ) = sem_Name_Special ( sem_Range range_ ) ( sem_Strings module_ ) name_ + +-- semantic domain +newtype T_Name = T_Name { + attach_T_Name :: Identity (T_Name_s113 ) + } +newtype T_Name_s113 = C_Name_s113 { + inv_Name_s113 :: (T_Name_v112 ) + } +data T_Name_s114 = C_Name_s114 +type T_Name_v112 = (T_Name_vIn112 ) -> (T_Name_vOut112 ) +data T_Name_vIn112 = T_Name_vIn112 +data T_Name_vOut112 = T_Name_vOut112 (Bool) (Bool) (Bool) (OneLineTree) (Name) +{-# NOINLINE sem_Name_Identifier #-} +sem_Name_Identifier :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Identifier arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIoneLineTree _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _lhsOisIdentifier :: Bool + _lhsOisIdentifier = rule336 () + _oneLineTree = rule337 arg_name_ + _lhsOisOperator :: Bool + _lhsOisOperator = rule338 () + _lhsOisSpecial :: Bool + _lhsOisSpecial = rule339 () + _self = rule340 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule341 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule342 _oneLineTree + __result_ = T_Name_vOut112 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule336 #-} + rule336 = \ (_ :: ()) -> + True + {-# INLINE rule337 #-} + rule337 = \ name_ -> + OneLineText name_ + {-# INLINE rule338 #-} + rule338 = \ (_ :: ()) -> + False + {-# INLINE rule339 #-} + rule339 = \ (_ :: ()) -> + False + {-# INLINE rule340 #-} + rule340 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Identifier _rangeIself _moduleIself name_ + {-# INLINE rule341 #-} + rule341 = \ _self -> + _self + {-# INLINE rule342 #-} + rule342 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Name_Operator #-} +sem_Name_Operator :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Operator arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIoneLineTree _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _lhsOisOperator :: Bool + _lhsOisOperator = rule343 () + _oneLineTree = rule344 arg_name_ + _lhsOisIdentifier :: Bool + _lhsOisIdentifier = rule345 () + _lhsOisSpecial :: Bool + _lhsOisSpecial = rule346 () + _self = rule347 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule348 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule349 _oneLineTree + __result_ = T_Name_vOut112 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule343 #-} + rule343 = \ (_ :: ()) -> + True + {-# INLINE rule344 #-} + rule344 = \ name_ -> + OneLineText name_ + {-# INLINE rule345 #-} + rule345 = \ (_ :: ()) -> + False + {-# INLINE rule346 #-} + rule346 = \ (_ :: ()) -> + False + {-# INLINE rule347 #-} + rule347 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Operator _rangeIself _moduleIself name_ + {-# INLINE rule348 #-} + rule348 = \ _self -> + _self + {-# INLINE rule349 #-} + rule349 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Name_Special #-} +sem_Name_Special :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Special arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleIoneLineTree _moduleIself) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _lhsOisSpecial :: Bool + _lhsOisSpecial = rule350 () + _oneLineTree = rule351 arg_name_ + _lhsOisIdentifier :: Bool + _lhsOisIdentifier = rule352 () + _lhsOisOperator :: Bool + _lhsOisOperator = rule353 () + _self = rule354 _moduleIself _rangeIself arg_name_ + _lhsOself :: Name + _lhsOself = rule355 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule356 _oneLineTree + __result_ = T_Name_vOut112 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule350 #-} + rule350 = \ (_ :: ()) -> + True + {-# INLINE rule351 #-} + rule351 = \ name_ -> + OneLineText name_ + {-# INLINE rule352 #-} + rule352 = \ (_ :: ()) -> + False + {-# INLINE rule353 #-} + rule353 = \ (_ :: ()) -> + False + {-# INLINE rule354 #-} + rule354 = \ ((_moduleIself) :: Strings) ((_rangeIself) :: Range) name_ -> + Name_Special _rangeIself _moduleIself name_ + {-# INLINE rule355 #-} + rule355 = \ _self -> + _self + {-# INLINE rule356 #-} + rule356 = \ _oneLineTree -> + _oneLineTree + +-- Names ------------------------------------------------------- +-- wrapper +data Inh_Names = Inh_Names { } +data Syn_Names = Syn_Names { isIdentifier_Syn_Names :: ( [Bool] ), isOperator_Syn_Names :: ( [Bool] ), isSpecial_Syn_Names :: ( [Bool] ), oneLineTree_Syn_Names :: ( [ OneLineTree] ), self_Syn_Names :: (Names) } +{-# INLINABLE wrap_Names #-} +wrap_Names :: T_Names -> Inh_Names -> (Syn_Names ) +wrap_Names (T_Names act) (Inh_Names ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Names_vIn115 + (T_Names_vOut115 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOoneLineTree _lhsOself) <- return (inv_Names_s116 sem arg) + return (Syn_Names _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Names #-} +sem_Names :: Names -> T_Names +sem_Names list = Prelude.foldr sem_Names_Cons sem_Names_Nil (Prelude.map sem_Name list) + +-- semantic domain +newtype T_Names = T_Names { + attach_T_Names :: Identity (T_Names_s116 ) + } +newtype T_Names_s116 = C_Names_s116 { + inv_Names_s116 :: (T_Names_v115 ) + } +data T_Names_s117 = C_Names_s117 +type T_Names_v115 = (T_Names_vIn115 ) -> (T_Names_vOut115 ) +data T_Names_vIn115 = T_Names_vIn115 +data T_Names_vOut115 = T_Names_vOut115 ( [Bool] ) ( [Bool] ) ( [Bool] ) ( [ OneLineTree] ) (Names) +{-# NOINLINE sem_Names_Cons #-} +sem_Names_Cons :: T_Name -> T_Names -> T_Names +sem_Names_Cons arg_hd_ arg_tl_ = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _hdX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_hd_)) + _tlX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_tl_)) + (T_Name_vOut112 _hdIisIdentifier _hdIisOperator _hdIisSpecial _hdIoneLineTree _hdIself) = inv_Name_s113 _hdX113 (T_Name_vIn112 ) + (T_Names_vOut115 _tlIisIdentifier _tlIisOperator _tlIisSpecial _tlIoneLineTree _tlIself) = inv_Names_s116 _tlX116 (T_Names_vIn115 ) + _lhsOisIdentifier :: [Bool] + _lhsOisIdentifier = rule357 _hdIisIdentifier _tlIisIdentifier + _lhsOisOperator :: [Bool] + _lhsOisOperator = rule358 _hdIisOperator _tlIisOperator + _lhsOisSpecial :: [Bool] + _lhsOisSpecial = rule359 _hdIisSpecial _tlIisSpecial + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule360 _hdIoneLineTree _tlIoneLineTree + _self = rule361 _hdIself _tlIself + _lhsOself :: Names + _lhsOself = rule362 _self + __result_ = T_Names_vOut115 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule357 #-} + rule357 = \ ((_hdIisIdentifier) :: Bool) ((_tlIisIdentifier) :: [Bool] ) -> + _hdIisIdentifier : _tlIisIdentifier + {-# INLINE rule358 #-} + rule358 = \ ((_hdIisOperator) :: Bool) ((_tlIisOperator) :: [Bool] ) -> + _hdIisOperator : _tlIisOperator + {-# INLINE rule359 #-} + rule359 = \ ((_hdIisSpecial) :: Bool) ((_tlIisSpecial) :: [Bool] ) -> + _hdIisSpecial : _tlIisSpecial + {-# INLINE rule360 #-} + rule360 = \ ((_hdIoneLineTree) :: OneLineTree) ((_tlIoneLineTree) :: [ OneLineTree] ) -> + _hdIoneLineTree : _tlIoneLineTree + {-# INLINE rule361 #-} + rule361 = \ ((_hdIself) :: Name) ((_tlIself) :: Names) -> + (:) _hdIself _tlIself + {-# INLINE rule362 #-} + rule362 = \ _self -> + _self +{-# NOINLINE sem_Names_Nil #-} +sem_Names_Nil :: T_Names +sem_Names_Nil = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _lhsOisIdentifier :: [Bool] + _lhsOisIdentifier = rule363 () + _lhsOisOperator :: [Bool] + _lhsOisOperator = rule364 () + _lhsOisSpecial :: [Bool] + _lhsOisSpecial = rule365 () + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule366 () + _self = rule367 () + _lhsOself :: Names + _lhsOself = rule368 _self + __result_ = T_Names_vOut115 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule363 #-} + rule363 = \ (_ :: ()) -> + [] + {-# INLINE rule364 #-} + rule364 = \ (_ :: ()) -> + [] + {-# INLINE rule365 #-} + rule365 = \ (_ :: ()) -> + [] + {-# INLINE rule366 #-} + rule366 = \ (_ :: ()) -> + [] + {-# INLINE rule367 #-} + rule367 = \ (_ :: ()) -> + [] + {-# INLINE rule368 #-} + rule368 = \ _self -> + _self + +-- Pattern ----------------------------------------------------- +-- wrapper +data Inh_Pattern = Inh_Pattern { } +data Syn_Pattern = Syn_Pattern { oneLineTree_Syn_Pattern :: (OneLineTree), self_Syn_Pattern :: (Pattern) } +{-# INLINABLE wrap_Pattern #-} +wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) +wrap_Pattern (T_Pattern act) (Inh_Pattern ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Pattern_vIn118 + (T_Pattern_vOut118 _lhsOoneLineTree _lhsOself) <- return (inv_Pattern_s119 sem arg) + return (Syn_Pattern _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Pattern #-} +sem_Pattern :: Pattern -> T_Pattern +sem_Pattern ( Pattern_Hole range_ id_ ) = sem_Pattern_Hole ( sem_Range range_ ) id_ +sem_Pattern ( Pattern_Literal range_ literal_ ) = sem_Pattern_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_Variable range_ name_ ) = sem_Pattern_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Pattern ( Pattern_Constructor range_ name_ patterns_ ) = sem_Pattern_Constructor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Parenthesized range_ pattern_ ) = sem_Pattern_Parenthesized ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ ) = sem_Pattern_InfixConstructor ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name constructorOperator_ ) ( sem_Pattern rightPattern_ ) +sem_Pattern ( Pattern_List range_ patterns_ ) = sem_Pattern_List ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Tuple range_ patterns_ ) = sem_Pattern_Tuple ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Record range_ name_ recordPatternBindings_ ) = sem_Pattern_Record ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordPatternBindings recordPatternBindings_ ) +sem_Pattern ( Pattern_Negate range_ literal_ ) = sem_Pattern_Negate ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_As range_ name_ pattern_ ) = sem_Pattern_As ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Wildcard range_ ) = sem_Pattern_Wildcard ( sem_Range range_ ) +sem_Pattern ( Pattern_Irrefutable range_ pattern_ ) = sem_Pattern_Irrefutable ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Successor range_ name_ literal_ ) = sem_Pattern_Successor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_NegateFloat range_ literal_ ) = sem_Pattern_NegateFloat ( sem_Range range_ ) ( sem_Literal literal_ ) + +-- semantic domain +newtype T_Pattern = T_Pattern { + attach_T_Pattern :: Identity (T_Pattern_s119 ) + } +newtype T_Pattern_s119 = C_Pattern_s119 { + inv_Pattern_s119 :: (T_Pattern_v118 ) + } +data T_Pattern_s120 = C_Pattern_s120 +type T_Pattern_v118 = (T_Pattern_vIn118 ) -> (T_Pattern_vOut118 ) +data T_Pattern_vIn118 = T_Pattern_vIn118 +data T_Pattern_vOut118 = T_Pattern_vOut118 (OneLineTree) (Pattern) +{-# NOINLINE sem_Pattern_Hole #-} +sem_Pattern_Hole :: T_Range -> (Integer) -> T_Pattern +sem_Pattern_Hole arg_range_ arg_id_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule369 () + _self = rule370 _rangeIself arg_id_ + _lhsOself :: Pattern + _lhsOself = rule371 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule372 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule369 #-} + rule369 = \ (_ :: ()) -> + OneLineText hole + {-# INLINE rule370 #-} + rule370 = \ ((_rangeIself) :: Range) id_ -> + Pattern_Hole _rangeIself id_ + {-# INLINE rule371 #-} + rule371 = \ _self -> + _self + {-# INLINE rule372 #-} + rule372 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_Literal #-} +sem_Pattern_Literal :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Literal arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIoneLineTree _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _oneLineTree = rule373 _literalIoneLineTree + _self = rule374 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule375 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule376 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule373 #-} + rule373 = \ ((_literalIoneLineTree) :: OneLineTree) -> + _literalIoneLineTree + {-# INLINE rule374 #-} + rule374 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Literal _rangeIself _literalIself + {-# INLINE rule375 #-} + rule375 = \ _self -> + _self + {-# INLINE rule376 #-} + rule376 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_Variable #-} +sem_Pattern_Variable :: T_Range -> T_Name -> T_Pattern +sem_Pattern_Variable arg_range_ arg_name_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _oneLineTree = rule377 _nameIoneLineTree + _self = rule378 _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule379 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule380 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule377 #-} + rule377 = \ ((_nameIoneLineTree) :: OneLineTree) -> + _nameIoneLineTree + {-# INLINE rule378 #-} + rule378 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Variable _rangeIself _nameIself + {-# INLINE rule379 #-} + rule379 = \ _self -> + _self + {-# INLINE rule380 #-} + rule380 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_Constructor #-} +sem_Pattern_Constructor :: T_Range -> T_Name -> T_Patterns -> T_Pattern +sem_Pattern_Constructor arg_range_ arg_name_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsIoneLineTree _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _operatorName = rule381 _nameIisOperator _nameIoneLineTree + _oneLineTree = rule382 _operatorName _patternsIoneLineTree + _self = rule383 _nameIself _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule384 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule385 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule381 #-} + rule381 = \ ((_nameIisOperator) :: Bool) ((_nameIoneLineTree) :: OneLineTree) -> + if _nameIisOperator + then OneLineNode [OneLineText "(", _nameIoneLineTree, OneLineText ")"] + else _nameIoneLineTree + {-# INLINE rule382 #-} + rule382 = \ _operatorName ((_patternsIoneLineTree) :: [ OneLineTree] ) -> + OneLineNode (sepBy (OneLineText " ") (_operatorName : _patternsIoneLineTree)) + {-# INLINE rule383 #-} + rule383 = \ ((_nameIself) :: Name) ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Constructor _rangeIself _nameIself _patternsIself + {-# INLINE rule384 #-} + rule384 = \ _self -> + _self + {-# INLINE rule385 #-} + rule385 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_Parenthesized #-} +sem_Pattern_Parenthesized :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Parenthesized arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIoneLineTree _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _oneLineTree = rule386 _patternIoneLineTree + _self = rule387 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule388 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule389 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule386 #-} + rule386 = \ ((_patternIoneLineTree) :: OneLineTree) -> + parens _patternIoneLineTree + {-# INLINE rule387 #-} + rule387 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Parenthesized _rangeIself _patternIself + {-# INLINE rule388 #-} + rule388 = \ _self -> + _self + {-# INLINE rule389 #-} + rule389 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_InfixConstructor #-} +sem_Pattern_InfixConstructor :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_InfixConstructor arg_range_ arg_leftPattern_ arg_constructorOperator_ arg_rightPattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternIoneLineTree _leftPatternIself) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 ) + (T_Name_vOut112 _constructorOperatorIisIdentifier _constructorOperatorIisOperator _constructorOperatorIisSpecial _constructorOperatorIoneLineTree _constructorOperatorIself) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternIoneLineTree _rightPatternIself) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 ) + _operatorName = rule390 _constructorOperatorIself + _oneLineTree = rule391 _leftPatternIoneLineTree _operatorName _rightPatternIoneLineTree + _self = rule392 _constructorOperatorIself _leftPatternIself _rangeIself _rightPatternIself + _lhsOself :: Pattern + _lhsOself = rule393 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule394 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule390 #-} + rule390 = \ ((_constructorOperatorIself) :: Name) -> + OneLineText (showNameAsOperator _constructorOperatorIself) + {-# INLINE rule391 #-} + rule391 = \ ((_leftPatternIoneLineTree) :: OneLineTree) _operatorName ((_rightPatternIoneLineTree) :: OneLineTree) -> + OneLineNode + [ OneLineNode [_leftPatternIoneLineTree] + , OneLineText " " + , OneLineNode [_operatorName] + , OneLineText " " + , OneLineNode [_rightPatternIoneLineTree] + ] + {-# INLINE rule392 #-} + rule392 = \ ((_constructorOperatorIself) :: Name) ((_leftPatternIself) :: Pattern) ((_rangeIself) :: Range) ((_rightPatternIself) :: Pattern) -> + Pattern_InfixConstructor _rangeIself _leftPatternIself _constructorOperatorIself _rightPatternIself + {-# INLINE rule393 #-} + rule393 = \ _self -> + _self + {-# INLINE rule394 #-} + rule394 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_List #-} +sem_Pattern_List :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_List arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIoneLineTree _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _oneLineTree = rule395 _patternsIoneLineTree + _self = rule396 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule397 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule398 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule395 #-} + rule395 = \ ((_patternsIoneLineTree) :: [ OneLineTree] ) -> + encloseSep "[" ", " "]" _patternsIoneLineTree + {-# INLINE rule396 #-} + rule396 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_List _rangeIself _patternsIself + {-# INLINE rule397 #-} + rule397 = \ _self -> + _self + {-# INLINE rule398 #-} + rule398 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_Tuple #-} +sem_Pattern_Tuple :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_Tuple arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsIoneLineTree _patternsIself) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _oneLineTree = rule399 _patternsIoneLineTree + _self = rule400 _patternsIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule401 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule402 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule399 #-} + rule399 = \ ((_patternsIoneLineTree) :: [ OneLineTree] ) -> + encloseSep "(" ", " ")" _patternsIoneLineTree + {-# INLINE rule400 #-} + rule400 = \ ((_patternsIself) :: Patterns) ((_rangeIself) :: Range) -> + Pattern_Tuple _rangeIself _patternsIself + {-# INLINE rule401 #-} + rule401 = \ _self -> + _self + {-# INLINE rule402 #-} + rule402 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_Record #-} +sem_Pattern_Record :: T_Range -> T_Name -> T_RecordPatternBindings -> T_Pattern +sem_Pattern_Record arg_range_ arg_name_ arg_recordPatternBindings_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordPatternBindingsX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_recordPatternBindings_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordPatternBindings_vOut145 _recordPatternBindingsIself) = inv_RecordPatternBindings_s146 _recordPatternBindingsX146 (T_RecordPatternBindings_vIn145 ) + _oneLineTree = rule403 () + _self = rule404 _nameIself _rangeIself _recordPatternBindingsIself + _lhsOself :: Pattern + _lhsOself = rule405 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule406 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule403 #-} + rule403 = \ (_ :: ()) -> + intErr "pattern" "record" + {-# INLINE rule404 #-} + rule404 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_recordPatternBindingsIself) :: RecordPatternBindings) -> + Pattern_Record _rangeIself _nameIself _recordPatternBindingsIself + {-# INLINE rule405 #-} + rule405 = \ _self -> + _self + {-# INLINE rule406 #-} + rule406 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_Negate #-} +sem_Pattern_Negate :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Negate arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIoneLineTree _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _oneLineTree = rule407 _literalIoneLineTree + _self = rule408 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule409 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule410 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule407 #-} + rule407 = \ ((_literalIoneLineTree) :: OneLineTree) -> + OneLineNode [ OneLineText "-", _literalIoneLineTree ] + {-# INLINE rule408 #-} + rule408 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_Negate _rangeIself _literalIself + {-# INLINE rule409 #-} + rule409 = \ _self -> + _self + {-# INLINE rule410 #-} + rule410 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_As #-} +sem_Pattern_As :: T_Range -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_As arg_range_ arg_name_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIoneLineTree _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _oneLineTree = rule411 _nameIoneLineTree _patternIoneLineTree + _self = rule412 _nameIself _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule413 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule414 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule411 #-} + rule411 = \ ((_nameIoneLineTree) :: OneLineTree) ((_patternIoneLineTree) :: OneLineTree) -> + OneLineNode + [ OneLineNode [_nameIoneLineTree] + , OneLineText "@" + , OneLineNode [_patternIoneLineTree] + ] + {-# INLINE rule412 #-} + rule412 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_As _rangeIself _nameIself _patternIself + {-# INLINE rule413 #-} + rule413 = \ _self -> + _self + {-# INLINE rule414 #-} + rule414 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_Wildcard #-} +sem_Pattern_Wildcard :: T_Range -> T_Pattern +sem_Pattern_Wildcard arg_range_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule415 () + _self = rule416 _rangeIself + _lhsOself :: Pattern + _lhsOself = rule417 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule418 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule415 #-} + rule415 = \ (_ :: ()) -> + OneLineText "_" + {-# INLINE rule416 #-} + rule416 = \ ((_rangeIself) :: Range) -> + Pattern_Wildcard _rangeIself + {-# INLINE rule417 #-} + rule417 = \ _self -> + _self + {-# INLINE rule418 #-} + rule418 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_Irrefutable #-} +sem_Pattern_Irrefutable :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Irrefutable arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIoneLineTree _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _oneLineTree = rule419 () + _self = rule420 _patternIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule421 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule422 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule419 #-} + rule419 = \ (_ :: ()) -> + intErr "pattern" "irrefutable" + {-# INLINE rule420 #-} + rule420 = \ ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Pattern_Irrefutable _rangeIself _patternIself + {-# INLINE rule421 #-} + rule421 = \ _self -> + _self + {-# INLINE rule422 #-} + rule422 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_Successor #-} +sem_Pattern_Successor :: T_Range -> T_Name -> T_Literal -> T_Pattern +sem_Pattern_Successor arg_range_ arg_name_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Literal_vOut85 _literalIoneLineTree _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _oneLineTree = rule423 () + _self = rule424 _literalIself _nameIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule425 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule426 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule423 #-} + rule423 = \ (_ :: ()) -> + intErr "pattern" "successor" + {-# INLINE rule424 #-} + rule424 = \ ((_literalIself) :: Literal) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Pattern_Successor _rangeIself _nameIself _literalIself + {-# INLINE rule425 #-} + rule425 = \ _self -> + _self + {-# INLINE rule426 #-} + rule426 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Pattern_NegateFloat #-} +sem_Pattern_NegateFloat :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_NegateFloat arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalIoneLineTree _literalIself) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _oneLineTree = rule427 _literalIoneLineTree + _self = rule428 _literalIself _rangeIself + _lhsOself :: Pattern + _lhsOself = rule429 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule430 _oneLineTree + __result_ = T_Pattern_vOut118 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule427 #-} + rule427 = \ ((_literalIoneLineTree) :: OneLineTree) -> + OneLineNode [ OneLineText "-." , _literalIoneLineTree ] + {-# INLINE rule428 #-} + rule428 = \ ((_literalIself) :: Literal) ((_rangeIself) :: Range) -> + Pattern_NegateFloat _rangeIself _literalIself + {-# INLINE rule429 #-} + rule429 = \ _self -> + _self + {-# INLINE rule430 #-} + rule430 = \ _oneLineTree -> + _oneLineTree + +-- Patterns ---------------------------------------------------- +-- wrapper +data Inh_Patterns = Inh_Patterns { } +data Syn_Patterns = Syn_Patterns { oneLineTree_Syn_Patterns :: ( [ OneLineTree] ), self_Syn_Patterns :: (Patterns) } +{-# INLINABLE wrap_Patterns #-} +wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) +wrap_Patterns (T_Patterns act) (Inh_Patterns ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Patterns_vIn121 + (T_Patterns_vOut121 _lhsOoneLineTree _lhsOself) <- return (inv_Patterns_s122 sem arg) + return (Syn_Patterns _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Patterns #-} +sem_Patterns :: Patterns -> T_Patterns +sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) + +-- semantic domain +newtype T_Patterns = T_Patterns { + attach_T_Patterns :: Identity (T_Patterns_s122 ) + } +newtype T_Patterns_s122 = C_Patterns_s122 { + inv_Patterns_s122 :: (T_Patterns_v121 ) + } +data T_Patterns_s123 = C_Patterns_s123 +type T_Patterns_v121 = (T_Patterns_vIn121 ) -> (T_Patterns_vOut121 ) +data T_Patterns_vIn121 = T_Patterns_vIn121 +data T_Patterns_vOut121 = T_Patterns_vOut121 ( [ OneLineTree] ) (Patterns) +{-# NOINLINE sem_Patterns_Cons #-} +sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns +sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 ) -> ( let + _hdX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) + _tlX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) + (T_Pattern_vOut118 _hdIoneLineTree _hdIself) = inv_Pattern_s119 _hdX119 (T_Pattern_vIn118 ) + (T_Patterns_vOut121 _tlIoneLineTree _tlIself) = inv_Patterns_s122 _tlX122 (T_Patterns_vIn121 ) + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule431 _hdIoneLineTree _tlIoneLineTree + _self = rule432 _hdIself _tlIself + _lhsOself :: Patterns + _lhsOself = rule433 _self + __result_ = T_Patterns_vOut121 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule431 #-} + rule431 = \ ((_hdIoneLineTree) :: OneLineTree) ((_tlIoneLineTree) :: [ OneLineTree] ) -> + _hdIoneLineTree : _tlIoneLineTree + {-# INLINE rule432 #-} + rule432 = \ ((_hdIself) :: Pattern) ((_tlIself) :: Patterns) -> + (:) _hdIself _tlIself + {-# INLINE rule433 #-} + rule433 = \ _self -> + _self +{-# NOINLINE sem_Patterns_Nil #-} +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 ) -> ( let + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule434 () + _self = rule435 () + _lhsOself :: Patterns + _lhsOself = rule436 _self + __result_ = T_Patterns_vOut121 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule434 #-} + rule434 = \ (_ :: ()) -> + [] + {-# INLINE rule435 #-} + rule435 = \ (_ :: ()) -> + [] + {-# INLINE rule436 #-} + rule436 = \ _self -> + _self + +-- Position ---------------------------------------------------- +-- wrapper +data Inh_Position = Inh_Position { } +data Syn_Position = Syn_Position { self_Syn_Position :: (Position) } +{-# INLINABLE wrap_Position #-} +wrap_Position :: T_Position -> Inh_Position -> (Syn_Position ) +wrap_Position (T_Position act) (Inh_Position ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Position_vIn124 + (T_Position_vOut124 _lhsOself) <- return (inv_Position_s125 sem arg) + return (Syn_Position _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Position #-} +sem_Position :: Position -> T_Position +sem_Position ( Position_Position filename_ line_ column_ ) = sem_Position_Position filename_ line_ column_ +sem_Position ( Position_Unknown ) = sem_Position_Unknown + +-- semantic domain +newtype T_Position = T_Position { + attach_T_Position :: Identity (T_Position_s125 ) + } +newtype T_Position_s125 = C_Position_s125 { + inv_Position_s125 :: (T_Position_v124 ) + } +data T_Position_s126 = C_Position_s126 +type T_Position_v124 = (T_Position_vIn124 ) -> (T_Position_vOut124 ) +data T_Position_vIn124 = T_Position_vIn124 +data T_Position_vOut124 = T_Position_vOut124 (Position) +{-# NOINLINE sem_Position_Position #-} +sem_Position_Position :: (String) -> (Int) -> (Int) -> T_Position +sem_Position_Position arg_filename_ arg_line_ arg_column_ = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule437 arg_column_ arg_filename_ arg_line_ + _lhsOself :: Position + _lhsOself = rule438 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule437 #-} + rule437 = \ column_ filename_ line_ -> + Position_Position filename_ line_ column_ + {-# INLINE rule438 #-} + rule438 = \ _self -> + _self +{-# NOINLINE sem_Position_Unknown #-} +sem_Position_Unknown :: T_Position +sem_Position_Unknown = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _self = rule439 () + _lhsOself :: Position + _lhsOself = rule440 _self + __result_ = T_Position_vOut124 _lhsOself + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule439 #-} + rule439 = \ (_ :: ()) -> + Position_Unknown + {-# INLINE rule440 #-} + rule440 = \ _self -> + _self + +-- Qualifier --------------------------------------------------- +-- wrapper +data Inh_Qualifier = Inh_Qualifier { } +data Syn_Qualifier = Syn_Qualifier { oneLineTree_Syn_Qualifier :: (OneLineTree), self_Syn_Qualifier :: (Qualifier) } +{-# INLINABLE wrap_Qualifier #-} +wrap_Qualifier :: T_Qualifier -> Inh_Qualifier -> (Syn_Qualifier ) +wrap_Qualifier (T_Qualifier act) (Inh_Qualifier ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifier_vIn127 + (T_Qualifier_vOut127 _lhsOoneLineTree _lhsOself) <- return (inv_Qualifier_s128 sem arg) + return (Syn_Qualifier _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifier #-} +sem_Qualifier :: Qualifier -> T_Qualifier +sem_Qualifier ( Qualifier_Guard range_ guard_ ) = sem_Qualifier_Guard ( sem_Range range_ ) ( sem_Expression guard_ ) +sem_Qualifier ( Qualifier_Let range_ declarations_ ) = sem_Qualifier_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Qualifier ( Qualifier_Generator range_ pattern_ expression_ ) = sem_Qualifier_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Qualifier ( Qualifier_Empty range_ ) = sem_Qualifier_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Qualifier = T_Qualifier { + attach_T_Qualifier :: Identity (T_Qualifier_s128 ) + } +newtype T_Qualifier_s128 = C_Qualifier_s128 { + inv_Qualifier_s128 :: (T_Qualifier_v127 ) + } +data T_Qualifier_s129 = C_Qualifier_s129 +type T_Qualifier_v127 = (T_Qualifier_vIn127 ) -> (T_Qualifier_vOut127 ) +data T_Qualifier_vIn127 = T_Qualifier_vIn127 +data T_Qualifier_vOut127 = T_Qualifier_vOut127 (OneLineTree) (Qualifier) +{-# NOINLINE sem_Qualifier_Guard #-} +sem_Qualifier_Guard :: T_Range -> T_Expression -> T_Qualifier +sem_Qualifier_Guard arg_range_ arg_guard_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardIoneLineTree _guardIself) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 ) + _oneLineTree = rule441 _guardIoneLineTree + _self = rule442 _guardIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule443 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule444 _oneLineTree + __result_ = T_Qualifier_vOut127 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule441 #-} + rule441 = \ ((_guardIoneLineTree) :: OneLineTree) -> + _guardIoneLineTree + {-# INLINE rule442 #-} + rule442 = \ ((_guardIself) :: Expression) ((_rangeIself) :: Range) -> + Qualifier_Guard _rangeIself _guardIself + {-# INLINE rule443 #-} + rule443 = \ _self -> + _self + {-# INLINE rule444 #-} + rule444 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Qualifier_Let #-} +sem_Qualifier_Let :: T_Range -> T_Declarations -> T_Qualifier +sem_Qualifier_Let arg_range_ arg_declarations_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIoneLineTree _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _oneLineTree = rule445 _declarationsIoneLineTree + _self = rule446 _declarationsIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule447 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule448 _oneLineTree + __result_ = T_Qualifier_vOut127 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule445 #-} + rule445 = \ ((_declarationsIoneLineTree) :: [ OneLineTree] ) -> + OneLineNode [ OneLineText "let ", encloseSep "{" "; " "}" _declarationsIoneLineTree ] + {-# INLINE rule446 #-} + rule446 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Qualifier_Let _rangeIself _declarationsIself + {-# INLINE rule447 #-} + rule447 = \ _self -> + _self + {-# INLINE rule448 #-} + rule448 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Qualifier_Generator #-} +sem_Qualifier_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Qualifier +sem_Qualifier_Generator arg_range_ arg_pattern_ arg_expression_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIoneLineTree _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _oneLineTree = rule449 _expressionIoneLineTree _patternIoneLineTree + _self = rule450 _expressionIself _patternIself _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule451 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule452 _oneLineTree + __result_ = T_Qualifier_vOut127 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule449 #-} + rule449 = \ ((_expressionIoneLineTree) :: OneLineTree) ((_patternIoneLineTree) :: OneLineTree) -> + OneLineNode [ _patternIoneLineTree, OneLineText " <- ", _expressionIoneLineTree ] + {-# INLINE rule450 #-} + rule450 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Qualifier_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule451 #-} + rule451 = \ _self -> + _self + {-# INLINE rule452 #-} + rule452 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Qualifier_Empty #-} +sem_Qualifier_Empty :: T_Range -> T_Qualifier +sem_Qualifier_Empty arg_range_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule453 () + _self = rule454 _rangeIself + _lhsOself :: Qualifier + _lhsOself = rule455 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule456 _oneLineTree + __result_ = T_Qualifier_vOut127 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule453 #-} + rule453 = \ (_ :: ()) -> + OneLineText "" + {-# INLINE rule454 #-} + rule454 = \ ((_rangeIself) :: Range) -> + Qualifier_Empty _rangeIself + {-# INLINE rule455 #-} + rule455 = \ _self -> + _self + {-# INLINE rule456 #-} + rule456 = \ _oneLineTree -> + _oneLineTree + +-- Qualifiers -------------------------------------------------- +-- wrapper +data Inh_Qualifiers = Inh_Qualifiers { } +data Syn_Qualifiers = Syn_Qualifiers { oneLineTree_Syn_Qualifiers :: ( [ OneLineTree] ), self_Syn_Qualifiers :: (Qualifiers) } +{-# INLINABLE wrap_Qualifiers #-} +wrap_Qualifiers :: T_Qualifiers -> Inh_Qualifiers -> (Syn_Qualifiers ) +wrap_Qualifiers (T_Qualifiers act) (Inh_Qualifiers ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifiers_vIn130 + (T_Qualifiers_vOut130 _lhsOoneLineTree _lhsOself) <- return (inv_Qualifiers_s131 sem arg) + return (Syn_Qualifiers _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Qualifiers #-} +sem_Qualifiers :: Qualifiers -> T_Qualifiers +sem_Qualifiers list = Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list) + +-- semantic domain +newtype T_Qualifiers = T_Qualifiers { + attach_T_Qualifiers :: Identity (T_Qualifiers_s131 ) + } +newtype T_Qualifiers_s131 = C_Qualifiers_s131 { + inv_Qualifiers_s131 :: (T_Qualifiers_v130 ) + } +data T_Qualifiers_s132 = C_Qualifiers_s132 +type T_Qualifiers_v130 = (T_Qualifiers_vIn130 ) -> (T_Qualifiers_vOut130 ) +data T_Qualifiers_vIn130 = T_Qualifiers_vIn130 +data T_Qualifiers_vOut130 = T_Qualifiers_vOut130 ( [ OneLineTree] ) (Qualifiers) +{-# NOINLINE sem_Qualifiers_Cons #-} +sem_Qualifiers_Cons :: T_Qualifier -> T_Qualifiers -> T_Qualifiers +sem_Qualifiers_Cons arg_hd_ arg_tl_ = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 ) -> ( let + _hdX128 = Control.Monad.Identity.runIdentity (attach_T_Qualifier (arg_hd_)) + _tlX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_tl_)) + (T_Qualifier_vOut127 _hdIoneLineTree _hdIself) = inv_Qualifier_s128 _hdX128 (T_Qualifier_vIn127 ) + (T_Qualifiers_vOut130 _tlIoneLineTree _tlIself) = inv_Qualifiers_s131 _tlX131 (T_Qualifiers_vIn130 ) + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule457 _hdIoneLineTree _tlIoneLineTree + _self = rule458 _hdIself _tlIself + _lhsOself :: Qualifiers + _lhsOself = rule459 _self + __result_ = T_Qualifiers_vOut130 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule457 #-} + rule457 = \ ((_hdIoneLineTree) :: OneLineTree) ((_tlIoneLineTree) :: [ OneLineTree] ) -> + _hdIoneLineTree : _tlIoneLineTree + {-# INLINE rule458 #-} + rule458 = \ ((_hdIself) :: Qualifier) ((_tlIself) :: Qualifiers) -> + (:) _hdIself _tlIself + {-# INLINE rule459 #-} + rule459 = \ _self -> + _self +{-# NOINLINE sem_Qualifiers_Nil #-} +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 ) -> ( let + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule460 () + _self = rule461 () + _lhsOself :: Qualifiers + _lhsOself = rule462 _self + __result_ = T_Qualifiers_vOut130 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule460 #-} + rule460 = \ (_ :: ()) -> + [] + {-# INLINE rule461 #-} + rule461 = \ (_ :: ()) -> + [] + {-# INLINE rule462 #-} + rule462 = \ _self -> + _self + +-- Range ------------------------------------------------------- +-- wrapper +data Inh_Range = Inh_Range { } +data Syn_Range = Syn_Range { self_Syn_Range :: (Range) } +{-# INLINABLE wrap_Range #-} +wrap_Range :: T_Range -> Inh_Range -> (Syn_Range ) +wrap_Range (T_Range act) (Inh_Range ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Range_vIn133 + (T_Range_vOut133 _lhsOself) <- return (inv_Range_s134 sem arg) + return (Syn_Range _lhsOself) + ) + +-- cata +{-# INLINE sem_Range #-} +sem_Range :: Range -> T_Range +sem_Range ( Range_Range start_ stop_ ) = sem_Range_Range ( sem_Position start_ ) ( sem_Position stop_ ) + +-- semantic domain +newtype T_Range = T_Range { + attach_T_Range :: Identity (T_Range_s134 ) + } +newtype T_Range_s134 = C_Range_s134 { + inv_Range_s134 :: (T_Range_v133 ) + } +data T_Range_s135 = C_Range_s135 +type T_Range_v133 = (T_Range_vIn133 ) -> (T_Range_vOut133 ) +data T_Range_vIn133 = T_Range_vIn133 +data T_Range_vOut133 = T_Range_vOut133 (Range) +{-# NOINLINE sem_Range_Range #-} +sem_Range_Range :: T_Position -> T_Position -> T_Range +sem_Range_Range arg_start_ arg_stop_ = T_Range (return st134) where + {-# NOINLINE st134 #-} + st134 = let + v133 :: T_Range_v133 + v133 = \ (T_Range_vIn133 ) -> ( let + _startX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_start_)) + _stopX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_stop_)) + (T_Position_vOut124 _startIself) = inv_Position_s125 _startX125 (T_Position_vIn124 ) + (T_Position_vOut124 _stopIself) = inv_Position_s125 _stopX125 (T_Position_vIn124 ) + _self = rule463 _startIself _stopIself + _lhsOself :: Range + _lhsOself = rule464 _self + __result_ = T_Range_vOut133 _lhsOself + in __result_ ) + in C_Range_s134 v133 + {-# INLINE rule463 #-} + rule463 = \ ((_startIself) :: Position) ((_stopIself) :: Position) -> + Range_Range _startIself _stopIself + {-# INLINE rule464 #-} + rule464 = \ _self -> + _self + +-- RecordExpressionBinding ------------------------------------- +-- wrapper +data Inh_RecordExpressionBinding = Inh_RecordExpressionBinding { } +data Syn_RecordExpressionBinding = Syn_RecordExpressionBinding { self_Syn_RecordExpressionBinding :: (RecordExpressionBinding) } +{-# INLINABLE wrap_RecordExpressionBinding #-} +wrap_RecordExpressionBinding :: T_RecordExpressionBinding -> Inh_RecordExpressionBinding -> (Syn_RecordExpressionBinding ) +wrap_RecordExpressionBinding (T_RecordExpressionBinding act) (Inh_RecordExpressionBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBinding_vIn136 + (T_RecordExpressionBinding_vOut136 _lhsOself) <- return (inv_RecordExpressionBinding_s137 sem arg) + return (Syn_RecordExpressionBinding _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBinding #-} +sem_RecordExpressionBinding :: RecordExpressionBinding -> T_RecordExpressionBinding +sem_RecordExpressionBinding ( RecordExpressionBinding_RecordExpressionBinding range_ name_ expression_ ) = sem_RecordExpressionBinding_RecordExpressionBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_RecordExpressionBinding = T_RecordExpressionBinding { + attach_T_RecordExpressionBinding :: Identity (T_RecordExpressionBinding_s137 ) + } +newtype T_RecordExpressionBinding_s137 = C_RecordExpressionBinding_s137 { + inv_RecordExpressionBinding_s137 :: (T_RecordExpressionBinding_v136 ) + } +data T_RecordExpressionBinding_s138 = C_RecordExpressionBinding_s138 +type T_RecordExpressionBinding_v136 = (T_RecordExpressionBinding_vIn136 ) -> (T_RecordExpressionBinding_vOut136 ) +data T_RecordExpressionBinding_vIn136 = T_RecordExpressionBinding_vIn136 +data T_RecordExpressionBinding_vOut136 = T_RecordExpressionBinding_vOut136 (RecordExpressionBinding) +{-# NOINLINE sem_RecordExpressionBinding_RecordExpressionBinding #-} +sem_RecordExpressionBinding_RecordExpressionBinding :: T_Range -> T_Name -> T_Expression -> T_RecordExpressionBinding +sem_RecordExpressionBinding_RecordExpressionBinding arg_range_ arg_name_ arg_expression_ = T_RecordExpressionBinding (return st137) where + {-# NOINLINE st137 #-} + st137 = let + v136 :: T_RecordExpressionBinding_v136 + v136 = \ (T_RecordExpressionBinding_vIn136 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _self = rule465 _expressionIself _nameIself _rangeIself + _lhsOself :: RecordExpressionBinding + _lhsOself = rule466 _self + __result_ = T_RecordExpressionBinding_vOut136 _lhsOself + in __result_ ) + in C_RecordExpressionBinding_s137 v136 + {-# INLINE rule465 #-} + rule465 = \ ((_expressionIself) :: Expression) ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + RecordExpressionBinding_RecordExpressionBinding _rangeIself _nameIself _expressionIself + {-# INLINE rule466 #-} + rule466 = \ _self -> + _self + +-- RecordExpressionBindings ------------------------------------ +-- wrapper +data Inh_RecordExpressionBindings = Inh_RecordExpressionBindings { } +data Syn_RecordExpressionBindings = Syn_RecordExpressionBindings { self_Syn_RecordExpressionBindings :: (RecordExpressionBindings) } +{-# INLINABLE wrap_RecordExpressionBindings #-} +wrap_RecordExpressionBindings :: T_RecordExpressionBindings -> Inh_RecordExpressionBindings -> (Syn_RecordExpressionBindings ) +wrap_RecordExpressionBindings (T_RecordExpressionBindings act) (Inh_RecordExpressionBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBindings_vIn139 + (T_RecordExpressionBindings_vOut139 _lhsOself) <- return (inv_RecordExpressionBindings_s140 sem arg) + return (Syn_RecordExpressionBindings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBindings #-} +sem_RecordExpressionBindings :: RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings list = Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list) + +-- semantic domain +newtype T_RecordExpressionBindings = T_RecordExpressionBindings { + attach_T_RecordExpressionBindings :: Identity (T_RecordExpressionBindings_s140 ) + } +newtype T_RecordExpressionBindings_s140 = C_RecordExpressionBindings_s140 { + inv_RecordExpressionBindings_s140 :: (T_RecordExpressionBindings_v139 ) + } +data T_RecordExpressionBindings_s141 = C_RecordExpressionBindings_s141 +type T_RecordExpressionBindings_v139 = (T_RecordExpressionBindings_vIn139 ) -> (T_RecordExpressionBindings_vOut139 ) +data T_RecordExpressionBindings_vIn139 = T_RecordExpressionBindings_vIn139 +data T_RecordExpressionBindings_vOut139 = T_RecordExpressionBindings_vOut139 (RecordExpressionBindings) +{-# NOINLINE sem_RecordExpressionBindings_Cons #-} +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> T_RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons arg_hd_ arg_tl_ = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 ) -> ( let + _hdX137 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBinding (arg_hd_)) + _tlX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_tl_)) + (T_RecordExpressionBinding_vOut136 _hdIself) = inv_RecordExpressionBinding_s137 _hdX137 (T_RecordExpressionBinding_vIn136 ) + (T_RecordExpressionBindings_vOut139 _tlIself) = inv_RecordExpressionBindings_s140 _tlX140 (T_RecordExpressionBindings_vIn139 ) + _self = rule467 _hdIself _tlIself + _lhsOself :: RecordExpressionBindings + _lhsOself = rule468 _self + __result_ = T_RecordExpressionBindings_vOut139 _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule467 #-} + rule467 = \ ((_hdIself) :: RecordExpressionBinding) ((_tlIself) :: RecordExpressionBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule468 #-} + rule468 = \ _self -> + _self +{-# NOINLINE sem_RecordExpressionBindings_Nil #-} +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 ) -> ( let + _self = rule469 () + _lhsOself :: RecordExpressionBindings + _lhsOself = rule470 _self + __result_ = T_RecordExpressionBindings_vOut139 _lhsOself + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule469 #-} + rule469 = \ (_ :: ()) -> + [] + {-# INLINE rule470 #-} + rule470 = \ _self -> + _self + +-- RecordPatternBinding ---------------------------------------- +-- wrapper +data Inh_RecordPatternBinding = Inh_RecordPatternBinding { } +data Syn_RecordPatternBinding = Syn_RecordPatternBinding { self_Syn_RecordPatternBinding :: (RecordPatternBinding) } +{-# INLINABLE wrap_RecordPatternBinding #-} +wrap_RecordPatternBinding :: T_RecordPatternBinding -> Inh_RecordPatternBinding -> (Syn_RecordPatternBinding ) +wrap_RecordPatternBinding (T_RecordPatternBinding act) (Inh_RecordPatternBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBinding_vIn142 + (T_RecordPatternBinding_vOut142 _lhsOself) <- return (inv_RecordPatternBinding_s143 sem arg) + return (Syn_RecordPatternBinding _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBinding #-} +sem_RecordPatternBinding :: RecordPatternBinding -> T_RecordPatternBinding +sem_RecordPatternBinding ( RecordPatternBinding_RecordPatternBinding range_ name_ pattern_ ) = sem_RecordPatternBinding_RecordPatternBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) + +-- semantic domain +newtype T_RecordPatternBinding = T_RecordPatternBinding { + attach_T_RecordPatternBinding :: Identity (T_RecordPatternBinding_s143 ) + } +newtype T_RecordPatternBinding_s143 = C_RecordPatternBinding_s143 { + inv_RecordPatternBinding_s143 :: (T_RecordPatternBinding_v142 ) + } +data T_RecordPatternBinding_s144 = C_RecordPatternBinding_s144 +type T_RecordPatternBinding_v142 = (T_RecordPatternBinding_vIn142 ) -> (T_RecordPatternBinding_vOut142 ) +data T_RecordPatternBinding_vIn142 = T_RecordPatternBinding_vIn142 +data T_RecordPatternBinding_vOut142 = T_RecordPatternBinding_vOut142 (RecordPatternBinding) +{-# NOINLINE sem_RecordPatternBinding_RecordPatternBinding #-} +sem_RecordPatternBinding_RecordPatternBinding :: T_Range -> T_Name -> T_Pattern -> T_RecordPatternBinding +sem_RecordPatternBinding_RecordPatternBinding arg_range_ arg_name_ arg_pattern_ = T_RecordPatternBinding (return st143) where + {-# NOINLINE st143 #-} + st143 = let + v142 :: T_RecordPatternBinding_v142 + v142 = \ (T_RecordPatternBinding_vIn142 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternIoneLineTree _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _self = rule471 _nameIself _patternIself _rangeIself + _lhsOself :: RecordPatternBinding + _lhsOself = rule472 _self + __result_ = T_RecordPatternBinding_vOut142 _lhsOself + in __result_ ) + in C_RecordPatternBinding_s143 v142 + {-# INLINE rule471 #-} + rule471 = \ ((_nameIself) :: Name) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + RecordPatternBinding_RecordPatternBinding _rangeIself _nameIself _patternIself + {-# INLINE rule472 #-} + rule472 = \ _self -> + _self + +-- RecordPatternBindings --------------------------------------- +-- wrapper +data Inh_RecordPatternBindings = Inh_RecordPatternBindings { } +data Syn_RecordPatternBindings = Syn_RecordPatternBindings { self_Syn_RecordPatternBindings :: (RecordPatternBindings) } +{-# INLINABLE wrap_RecordPatternBindings #-} +wrap_RecordPatternBindings :: T_RecordPatternBindings -> Inh_RecordPatternBindings -> (Syn_RecordPatternBindings ) +wrap_RecordPatternBindings (T_RecordPatternBindings act) (Inh_RecordPatternBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBindings_vIn145 + (T_RecordPatternBindings_vOut145 _lhsOself) <- return (inv_RecordPatternBindings_s146 sem arg) + return (Syn_RecordPatternBindings _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBindings #-} +sem_RecordPatternBindings :: RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings list = Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list) + +-- semantic domain +newtype T_RecordPatternBindings = T_RecordPatternBindings { + attach_T_RecordPatternBindings :: Identity (T_RecordPatternBindings_s146 ) + } +newtype T_RecordPatternBindings_s146 = C_RecordPatternBindings_s146 { + inv_RecordPatternBindings_s146 :: (T_RecordPatternBindings_v145 ) + } +data T_RecordPatternBindings_s147 = C_RecordPatternBindings_s147 +type T_RecordPatternBindings_v145 = (T_RecordPatternBindings_vIn145 ) -> (T_RecordPatternBindings_vOut145 ) +data T_RecordPatternBindings_vIn145 = T_RecordPatternBindings_vIn145 +data T_RecordPatternBindings_vOut145 = T_RecordPatternBindings_vOut145 (RecordPatternBindings) +{-# NOINLINE sem_RecordPatternBindings_Cons #-} +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> T_RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings_Cons arg_hd_ arg_tl_ = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 ) -> ( let + _hdX143 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBinding (arg_hd_)) + _tlX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_tl_)) + (T_RecordPatternBinding_vOut142 _hdIself) = inv_RecordPatternBinding_s143 _hdX143 (T_RecordPatternBinding_vIn142 ) + (T_RecordPatternBindings_vOut145 _tlIself) = inv_RecordPatternBindings_s146 _tlX146 (T_RecordPatternBindings_vIn145 ) + _self = rule473 _hdIself _tlIself + _lhsOself :: RecordPatternBindings + _lhsOself = rule474 _self + __result_ = T_RecordPatternBindings_vOut145 _lhsOself + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule473 #-} + rule473 = \ ((_hdIself) :: RecordPatternBinding) ((_tlIself) :: RecordPatternBindings) -> + (:) _hdIself _tlIself + {-# INLINE rule474 #-} + rule474 = \ _self -> + _self +{-# NOINLINE sem_RecordPatternBindings_Nil #-} +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 ) -> ( let + _self = rule475 () + _lhsOself :: RecordPatternBindings + _lhsOself = rule476 _self + __result_ = T_RecordPatternBindings_vOut145 _lhsOself + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule475 #-} + rule475 = \ (_ :: ()) -> + [] + {-# INLINE rule476 #-} + rule476 = \ _self -> + _self + +-- RightHandSide ----------------------------------------------- +-- wrapper +data Inh_RightHandSide = Inh_RightHandSide { } +data Syn_RightHandSide = Syn_RightHandSide { oneLineTree_Syn_RightHandSide :: ( String -> OneLineTree ), self_Syn_RightHandSide :: (RightHandSide) } +{-# INLINABLE wrap_RightHandSide #-} +wrap_RightHandSide :: T_RightHandSide -> Inh_RightHandSide -> (Syn_RightHandSide ) +wrap_RightHandSide (T_RightHandSide act) (Inh_RightHandSide ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RightHandSide_vIn148 + (T_RightHandSide_vOut148 _lhsOoneLineTree _lhsOself) <- return (inv_RightHandSide_s149 sem arg) + return (Syn_RightHandSide _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_RightHandSide #-} +sem_RightHandSide :: RightHandSide -> T_RightHandSide +sem_RightHandSide ( RightHandSide_Expression range_ expression_ where_ ) = sem_RightHandSide_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_MaybeDeclarations where_ ) +sem_RightHandSide ( RightHandSide_Guarded range_ guardedexpressions_ where_ ) = sem_RightHandSide_Guarded ( sem_Range range_ ) ( sem_GuardedExpressions guardedexpressions_ ) ( sem_MaybeDeclarations where_ ) + +-- semantic domain +newtype T_RightHandSide = T_RightHandSide { + attach_T_RightHandSide :: Identity (T_RightHandSide_s149 ) + } +newtype T_RightHandSide_s149 = C_RightHandSide_s149 { + inv_RightHandSide_s149 :: (T_RightHandSide_v148 ) + } +data T_RightHandSide_s150 = C_RightHandSide_s150 +type T_RightHandSide_v148 = (T_RightHandSide_vIn148 ) -> (T_RightHandSide_vOut148 ) +data T_RightHandSide_vIn148 = T_RightHandSide_vIn148 +data T_RightHandSide_vOut148 = T_RightHandSide_vOut148 ( String -> OneLineTree ) (RightHandSide) +{-# NOINLINE sem_RightHandSide_Expression #-} +sem_RightHandSide_Expression :: T_Range -> T_Expression -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Expression arg_range_ arg_expression_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_MaybeDeclarations_vOut88 _whereIoneLineTree _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _oneLineTree = rule477 _expressionIoneLineTree _whereIoneLineTree + _self = rule478 _expressionIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule479 _self + _lhsOoneLineTree :: String -> OneLineTree + _lhsOoneLineTree = rule480 _oneLineTree + __result_ = T_RightHandSide_vOut148 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule477 #-} + rule477 = \ ((_expressionIoneLineTree) :: OneLineTree) ((_whereIoneLineTree) :: Maybe [OneLineTree] ) -> + \assign -> OneLineNode + ( [ OneLineText assign, _expressionIoneLineTree ] + ++ case _whereIoneLineTree of + Nothing -> [] + Just ds -> [ OneLineText " where ", encloseSep "{" "; " "}" ds ] + ) + {-# INLINE rule478 #-} + rule478 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Expression _rangeIself _expressionIself _whereIself + {-# INLINE rule479 #-} + rule479 = \ _self -> + _self + {-# INLINE rule480 #-} + rule480 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_RightHandSide_Guarded #-} +sem_RightHandSide_Guarded :: T_Range -> T_GuardedExpressions -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Guarded arg_range_ arg_guardedexpressions_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardedexpressionsX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_guardedexpressions_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_GuardedExpressions_vOut64 _guardedexpressionsIoneLineTree _guardedexpressionsIself) = inv_GuardedExpressions_s65 _guardedexpressionsX65 (T_GuardedExpressions_vIn64 ) + (T_MaybeDeclarations_vOut88 _whereIoneLineTree _whereIself) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _oneLineTree = rule481 _guardedexpressionsIoneLineTree _whereIoneLineTree + _self = rule482 _guardedexpressionsIself _rangeIself _whereIself + _lhsOself :: RightHandSide + _lhsOself = rule483 _self + _lhsOoneLineTree :: String -> OneLineTree + _lhsOoneLineTree = rule484 _oneLineTree + __result_ = T_RightHandSide_vOut148 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule481 #-} + rule481 = \ ((_guardedexpressionsIoneLineTree) :: [ String -> OneLineTree ] ) ((_whereIoneLineTree) :: Maybe [OneLineTree] ) -> + \assign -> OneLineNode + ( [ ge assign | ge <- _guardedexpressionsIoneLineTree ] + ++ case _whereIoneLineTree of + Nothing -> [] + Just ds -> [ OneLineText " where ", encloseSep "{" "; " "}" ds ] + ) + {-# INLINE rule482 #-} + rule482 = \ ((_guardedexpressionsIself) :: GuardedExpressions) ((_rangeIself) :: Range) ((_whereIself) :: MaybeDeclarations) -> + RightHandSide_Guarded _rangeIself _guardedexpressionsIself _whereIself + {-# INLINE rule483 #-} + rule483 = \ _self -> + _self + {-# INLINE rule484 #-} + rule484 = \ _oneLineTree -> + _oneLineTree + +-- SimpleType -------------------------------------------------- +-- wrapper +data Inh_SimpleType = Inh_SimpleType { } +data Syn_SimpleType = Syn_SimpleType { self_Syn_SimpleType :: (SimpleType) } +{-# INLINABLE wrap_SimpleType #-} +wrap_SimpleType :: T_SimpleType -> Inh_SimpleType -> (Syn_SimpleType ) +wrap_SimpleType (T_SimpleType act) (Inh_SimpleType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_SimpleType_vIn151 + (T_SimpleType_vOut151 _lhsOself) <- return (inv_SimpleType_s152 sem arg) + return (Syn_SimpleType _lhsOself) + ) + +-- cata +{-# INLINE sem_SimpleType #-} +sem_SimpleType :: SimpleType -> T_SimpleType +sem_SimpleType ( SimpleType_SimpleType range_ name_ typevariables_ ) = sem_SimpleType_SimpleType ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Names typevariables_ ) + +-- semantic domain +newtype T_SimpleType = T_SimpleType { + attach_T_SimpleType :: Identity (T_SimpleType_s152 ) + } +newtype T_SimpleType_s152 = C_SimpleType_s152 { + inv_SimpleType_s152 :: (T_SimpleType_v151 ) + } +data T_SimpleType_s153 = C_SimpleType_s153 +type T_SimpleType_v151 = (T_SimpleType_vIn151 ) -> (T_SimpleType_vOut151 ) +data T_SimpleType_vIn151 = T_SimpleType_vIn151 +data T_SimpleType_vOut151 = T_SimpleType_vOut151 (SimpleType) +{-# NOINLINE sem_SimpleType_SimpleType #-} +sem_SimpleType_SimpleType :: T_Range -> T_Name -> T_Names -> T_SimpleType +sem_SimpleType_SimpleType arg_range_ arg_name_ arg_typevariables_ = T_SimpleType (return st152) where + {-# NOINLINE st152 #-} + st152 = let + v151 :: T_SimpleType_v151 + v151 = \ (T_SimpleType_vIn151 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Names_vOut115 _typevariablesIisIdentifier _typevariablesIisOperator _typevariablesIisSpecial _typevariablesIoneLineTree _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + _self = rule485 _nameIself _rangeIself _typevariablesIself + _lhsOself :: SimpleType + _lhsOself = rule486 _self + __result_ = T_SimpleType_vOut151 _lhsOself + in __result_ ) + in C_SimpleType_s152 v151 + {-# INLINE rule485 #-} + rule485 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) ((_typevariablesIself) :: Names) -> + SimpleType_SimpleType _rangeIself _nameIself _typevariablesIself + {-# INLINE rule486 #-} + rule486 = \ _self -> + _self + +-- Statement --------------------------------------------------- +-- wrapper +data Inh_Statement = Inh_Statement { } +data Syn_Statement = Syn_Statement { oneLineTree_Syn_Statement :: (OneLineTree), self_Syn_Statement :: (Statement) } +{-# INLINABLE wrap_Statement #-} +wrap_Statement :: T_Statement -> Inh_Statement -> (Syn_Statement ) +wrap_Statement (T_Statement act) (Inh_Statement ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statement_vIn154 + (T_Statement_vOut154 _lhsOoneLineTree _lhsOself) <- return (inv_Statement_s155 sem arg) + return (Syn_Statement _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statement #-} +sem_Statement :: Statement -> T_Statement +sem_Statement ( Statement_Expression range_ expression_ ) = sem_Statement_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Let range_ declarations_ ) = sem_Statement_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Statement ( Statement_Generator range_ pattern_ expression_ ) = sem_Statement_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Empty range_ ) = sem_Statement_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Statement = T_Statement { + attach_T_Statement :: Identity (T_Statement_s155 ) + } +newtype T_Statement_s155 = C_Statement_s155 { + inv_Statement_s155 :: (T_Statement_v154 ) + } +data T_Statement_s156 = C_Statement_s156 +type T_Statement_v154 = (T_Statement_vIn154 ) -> (T_Statement_vOut154 ) +data T_Statement_vIn154 = T_Statement_vIn154 +data T_Statement_vOut154 = T_Statement_vOut154 (OneLineTree) (Statement) +{-# NOINLINE sem_Statement_Expression #-} +sem_Statement_Expression :: T_Range -> T_Expression -> T_Statement +sem_Statement_Expression arg_range_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _oneLineTree = rule487 _expressionIoneLineTree + _self = rule488 _expressionIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule489 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule490 _oneLineTree + __result_ = T_Statement_vOut154 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule487 #-} + rule487 = \ ((_expressionIoneLineTree) :: OneLineTree) -> + _expressionIoneLineTree + {-# INLINE rule488 #-} + rule488 = \ ((_expressionIself) :: Expression) ((_rangeIself) :: Range) -> + Statement_Expression _rangeIself _expressionIself + {-# INLINE rule489 #-} + rule489 = \ _self -> + _self + {-# INLINE rule490 #-} + rule490 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Statement_Let #-} +sem_Statement_Let :: T_Range -> T_Declarations -> T_Statement +sem_Statement_Let arg_range_ arg_declarations_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsIoneLineTree _declarationsIself) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _oneLineTree = rule491 _declarationsIoneLineTree + _self = rule492 _declarationsIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule493 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule494 _oneLineTree + __result_ = T_Statement_vOut154 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule491 #-} + rule491 = \ ((_declarationsIoneLineTree) :: [ OneLineTree] ) -> + OneLineNode [ OneLineText "let ", encloseSep "{" "; " "}" _declarationsIoneLineTree ] + {-# INLINE rule492 #-} + rule492 = \ ((_declarationsIself) :: Declarations) ((_rangeIself) :: Range) -> + Statement_Let _rangeIself _declarationsIself + {-# INLINE rule493 #-} + rule493 = \ _self -> + _self + {-# INLINE rule494 #-} + rule494 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Statement_Generator #-} +sem_Statement_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Statement +sem_Statement_Generator arg_range_ arg_pattern_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternIoneLineTree _patternIself) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_Expression_vOut40 _expressionIoneLineTree _expressionIself) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _oneLineTree = rule495 _expressionIoneLineTree _patternIoneLineTree + _self = rule496 _expressionIself _patternIself _rangeIself + _lhsOself :: Statement + _lhsOself = rule497 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule498 _oneLineTree + __result_ = T_Statement_vOut154 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule495 #-} + rule495 = \ ((_expressionIoneLineTree) :: OneLineTree) ((_patternIoneLineTree) :: OneLineTree) -> + OneLineNode [ _patternIoneLineTree, OneLineText " <- ", _expressionIoneLineTree ] + {-# INLINE rule496 #-} + rule496 = \ ((_expressionIself) :: Expression) ((_patternIself) :: Pattern) ((_rangeIself) :: Range) -> + Statement_Generator _rangeIself _patternIself _expressionIself + {-# INLINE rule497 #-} + rule497 = \ _self -> + _self + {-# INLINE rule498 #-} + rule498 = \ _oneLineTree -> + _oneLineTree +{-# NOINLINE sem_Statement_Empty #-} +sem_Statement_Empty :: T_Range -> T_Statement +sem_Statement_Empty arg_range_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _oneLineTree = rule499 () + _self = rule500 _rangeIself + _lhsOself :: Statement + _lhsOself = rule501 _self + _lhsOoneLineTree :: OneLineTree + _lhsOoneLineTree = rule502 _oneLineTree + __result_ = T_Statement_vOut154 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule499 #-} + rule499 = \ (_ :: ()) -> + OneLineText "" + {-# INLINE rule500 #-} + rule500 = \ ((_rangeIself) :: Range) -> + Statement_Empty _rangeIself + {-# INLINE rule501 #-} + rule501 = \ _self -> + _self + {-# INLINE rule502 #-} + rule502 = \ _oneLineTree -> + _oneLineTree + +-- Statements -------------------------------------------------- +-- wrapper +data Inh_Statements = Inh_Statements { } +data Syn_Statements = Syn_Statements { oneLineTree_Syn_Statements :: ( [ OneLineTree] ), self_Syn_Statements :: (Statements) } +{-# INLINABLE wrap_Statements #-} +wrap_Statements :: T_Statements -> Inh_Statements -> (Syn_Statements ) +wrap_Statements (T_Statements act) (Inh_Statements ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statements_vIn157 + (T_Statements_vOut157 _lhsOoneLineTree _lhsOself) <- return (inv_Statements_s158 sem arg) + return (Syn_Statements _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Statements #-} +sem_Statements :: Statements -> T_Statements +sem_Statements list = Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list) + +-- semantic domain +newtype T_Statements = T_Statements { + attach_T_Statements :: Identity (T_Statements_s158 ) + } +newtype T_Statements_s158 = C_Statements_s158 { + inv_Statements_s158 :: (T_Statements_v157 ) + } +data T_Statements_s159 = C_Statements_s159 +type T_Statements_v157 = (T_Statements_vIn157 ) -> (T_Statements_vOut157 ) +data T_Statements_vIn157 = T_Statements_vIn157 +data T_Statements_vOut157 = T_Statements_vOut157 ( [ OneLineTree] ) (Statements) +{-# NOINLINE sem_Statements_Cons #-} +sem_Statements_Cons :: T_Statement -> T_Statements -> T_Statements +sem_Statements_Cons arg_hd_ arg_tl_ = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 ) -> ( let + _hdX155 = Control.Monad.Identity.runIdentity (attach_T_Statement (arg_hd_)) + _tlX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_tl_)) + (T_Statement_vOut154 _hdIoneLineTree _hdIself) = inv_Statement_s155 _hdX155 (T_Statement_vIn154 ) + (T_Statements_vOut157 _tlIoneLineTree _tlIself) = inv_Statements_s158 _tlX158 (T_Statements_vIn157 ) + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule503 _hdIoneLineTree _tlIoneLineTree + _self = rule504 _hdIself _tlIself + _lhsOself :: Statements + _lhsOself = rule505 _self + __result_ = T_Statements_vOut157 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule503 #-} + rule503 = \ ((_hdIoneLineTree) :: OneLineTree) ((_tlIoneLineTree) :: [ OneLineTree] ) -> + _hdIoneLineTree : _tlIoneLineTree + {-# INLINE rule504 #-} + rule504 = \ ((_hdIself) :: Statement) ((_tlIself) :: Statements) -> + (:) _hdIself _tlIself + {-# INLINE rule505 #-} + rule505 = \ _self -> + _self +{-# NOINLINE sem_Statements_Nil #-} +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 ) -> ( let + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule506 () + _self = rule507 () + _lhsOself :: Statements + _lhsOself = rule508 _self + __result_ = T_Statements_vOut157 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule506 #-} + rule506 = \ (_ :: ()) -> + [] + {-# INLINE rule507 #-} + rule507 = \ (_ :: ()) -> + [] + {-# INLINE rule508 #-} + rule508 = \ _self -> + _self + +-- Strings ----------------------------------------------------- +-- wrapper +data Inh_Strings = Inh_Strings { } +data Syn_Strings = Syn_Strings { oneLineTree_Syn_Strings :: ( [ OneLineTree] ), self_Syn_Strings :: (Strings) } +{-# INLINABLE wrap_Strings #-} +wrap_Strings :: T_Strings -> Inh_Strings -> (Syn_Strings ) +wrap_Strings (T_Strings act) (Inh_Strings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Strings_vIn160 + (T_Strings_vOut160 _lhsOoneLineTree _lhsOself) <- return (inv_Strings_s161 sem arg) + return (Syn_Strings _lhsOoneLineTree _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Strings #-} +sem_Strings :: Strings -> T_Strings +sem_Strings list = Prelude.foldr sem_Strings_Cons sem_Strings_Nil list + +-- semantic domain +newtype T_Strings = T_Strings { + attach_T_Strings :: Identity (T_Strings_s161 ) + } +newtype T_Strings_s161 = C_Strings_s161 { + inv_Strings_s161 :: (T_Strings_v160 ) + } +data T_Strings_s162 = C_Strings_s162 +type T_Strings_v160 = (T_Strings_vIn160 ) -> (T_Strings_vOut160 ) +data T_Strings_vIn160 = T_Strings_vIn160 +data T_Strings_vOut160 = T_Strings_vOut160 ( [ OneLineTree] ) (Strings) +{-# NOINLINE sem_Strings_Cons #-} +sem_Strings_Cons :: (String) -> T_Strings -> T_Strings +sem_Strings_Cons arg_hd_ arg_tl_ = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _tlX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_tl_)) + (T_Strings_vOut160 _tlIoneLineTree _tlIself) = inv_Strings_s161 _tlX161 (T_Strings_vIn160 ) + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule509 _tlIoneLineTree + _self = rule510 _tlIself arg_hd_ + _lhsOself :: Strings + _lhsOself = rule511 _self + __result_ = T_Strings_vOut160 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule509 #-} + rule509 = \ ((_tlIoneLineTree) :: [ OneLineTree] ) -> + _tlIoneLineTree + {-# INLINE rule510 #-} + rule510 = \ ((_tlIself) :: Strings) hd_ -> + (:) hd_ _tlIself + {-# INLINE rule511 #-} + rule511 = \ _self -> + _self +{-# NOINLINE sem_Strings_Nil #-} +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _lhsOoneLineTree :: [ OneLineTree] + _lhsOoneLineTree = rule512 () + _self = rule513 () + _lhsOself :: Strings + _lhsOself = rule514 _self + __result_ = T_Strings_vOut160 _lhsOoneLineTree _lhsOself + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule512 #-} + rule512 = \ (_ :: ()) -> + [] + {-# INLINE rule513 #-} + rule513 = \ (_ :: ()) -> + [] + {-# INLINE rule514 #-} + rule514 = \ _self -> + _self + +-- Type -------------------------------------------------------- +-- wrapper +data Inh_Type = Inh_Type { } +data Syn_Type = Syn_Type { self_Syn_Type :: (Type) } +{-# INLINABLE wrap_Type #-} +wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) +wrap_Type (T_Type act) (Inh_Type ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Type_vIn163 + (T_Type_vOut163 _lhsOself) <- return (inv_Type_s164 sem arg) + return (Syn_Type _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Type #-} +sem_Type :: Type -> T_Type +sem_Type ( Type_Application range_ prefix_ function_ arguments_ ) = sem_Type_Application ( sem_Range range_ ) prefix_ ( sem_Type function_ ) ( sem_Types arguments_ ) +sem_Type ( Type_Variable range_ name_ ) = sem_Type_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Constructor range_ name_ ) = sem_Type_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Qualified range_ context_ type_ ) = sem_Type_Qualified ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Type type_ ) +sem_Type ( Type_Forall range_ typevariables_ type_ ) = sem_Type_Forall ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Exists range_ typevariables_ type_ ) = sem_Type_Exists ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Parenthesized range_ type_ ) = sem_Type_Parenthesized ( sem_Range range_ ) ( sem_Type type_ ) + +-- semantic domain +newtype T_Type = T_Type { + attach_T_Type :: Identity (T_Type_s164 ) + } +newtype T_Type_s164 = C_Type_s164 { + inv_Type_s164 :: (T_Type_v163 ) + } +data T_Type_s165 = C_Type_s165 +type T_Type_v163 = (T_Type_vIn163 ) -> (T_Type_vOut163 ) +data T_Type_vIn163 = T_Type_vIn163 +data T_Type_vOut163 = T_Type_vOut163 (Type) +{-# NOINLINE sem_Type_Application #-} +sem_Type_Application :: T_Range -> (Bool) -> T_Type -> T_Types -> T_Type +sem_Type_Application arg_range_ arg_prefix_ arg_function_ arg_arguments_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_function_)) + _argumentsX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_arguments_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _functionIself) = inv_Type_s164 _functionX164 (T_Type_vIn163 ) + (T_Types_vOut166 _argumentsIself) = inv_Types_s167 _argumentsX167 (T_Types_vIn166 ) + _self = rule515 _argumentsIself _functionIself _rangeIself arg_prefix_ + _lhsOself :: Type + _lhsOself = rule516 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule515 #-} + rule515 = \ ((_argumentsIself) :: Types) ((_functionIself) :: Type) ((_rangeIself) :: Range) prefix_ -> + Type_Application _rangeIself prefix_ _functionIself _argumentsIself + {-# INLINE rule516 #-} + rule516 = \ _self -> + _self +{-# NOINLINE sem_Type_Variable #-} +sem_Type_Variable :: T_Range -> T_Name -> T_Type +sem_Type_Variable arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule517 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule518 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule517 #-} + rule517 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Variable _rangeIself _nameIself + {-# INLINE rule518 #-} + rule518 = \ _self -> + _self +{-# NOINLINE sem_Type_Constructor #-} +sem_Type_Constructor :: T_Range -> T_Name -> T_Type +sem_Type_Constructor arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameIoneLineTree _nameIself) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _self = rule519 _nameIself _rangeIself + _lhsOself :: Type + _lhsOself = rule520 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule519 #-} + rule519 = \ ((_nameIself) :: Name) ((_rangeIself) :: Range) -> + Type_Constructor _rangeIself _nameIself + {-# INLINE rule520 #-} + rule520 = \ _self -> + _self +{-# NOINLINE sem_Type_Qualified #-} +sem_Type_Qualified :: T_Range -> T_ContextItems -> T_Type -> T_Type +sem_Type_Qualified arg_range_ arg_context_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextIself) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule521 _contextIself _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule522 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule521 #-} + rule521 = \ ((_contextIself) :: ContextItems) ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Qualified _rangeIself _contextIself _typeIself + {-# INLINE rule522 #-} + rule522 = \ _self -> + _self +{-# NOINLINE sem_Type_Forall #-} +sem_Type_Forall :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Forall arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIisIdentifier _typevariablesIisOperator _typevariablesIisSpecial _typevariablesIoneLineTree _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule523 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule524 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule523 #-} + rule523 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Forall _rangeIself _typevariablesIself _typeIself + {-# INLINE rule524 #-} + rule524 = \ _self -> + _self +{-# NOINLINE sem_Type_Exists #-} +sem_Type_Exists :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Exists arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIisIdentifier _typevariablesIisOperator _typevariablesIisSpecial _typevariablesIoneLineTree _typevariablesIself) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule525 _rangeIself _typeIself _typevariablesIself + _lhsOself :: Type + _lhsOself = rule526 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule525 #-} + rule525 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) ((_typevariablesIself) :: Names) -> + Type_Exists _rangeIself _typevariablesIself _typeIself + {-# INLINE rule526 #-} + rule526 = \ _self -> + _self +{-# NOINLINE sem_Type_Parenthesized #-} +sem_Type_Parenthesized :: T_Range -> T_Type -> T_Type +sem_Type_Parenthesized arg_range_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeIself) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeIself) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _self = rule527 _rangeIself _typeIself + _lhsOself :: Type + _lhsOself = rule528 _self + __result_ = T_Type_vOut163 _lhsOself + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule527 #-} + rule527 = \ ((_rangeIself) :: Range) ((_typeIself) :: Type) -> + Type_Parenthesized _rangeIself _typeIself + {-# INLINE rule528 #-} + rule528 = \ _self -> + _self + +-- Types ------------------------------------------------------- +-- wrapper +data Inh_Types = Inh_Types { } +data Syn_Types = Syn_Types { self_Syn_Types :: (Types) } +{-# INLINABLE wrap_Types #-} +wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) +wrap_Types (T_Types act) (Inh_Types ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Types_vIn166 + (T_Types_vOut166 _lhsOself) <- return (inv_Types_s167 sem arg) + return (Syn_Types _lhsOself) + ) + +-- cata +{-# NOINLINE sem_Types #-} +sem_Types :: Types -> T_Types +sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) + +-- semantic domain +newtype T_Types = T_Types { + attach_T_Types :: Identity (T_Types_s167 ) + } +newtype T_Types_s167 = C_Types_s167 { + inv_Types_s167 :: (T_Types_v166 ) + } +data T_Types_s168 = C_Types_s168 +type T_Types_v166 = (T_Types_vIn166 ) -> (T_Types_vOut166 ) +data T_Types_vIn166 = T_Types_vIn166 +data T_Types_vOut166 = T_Types_vOut166 (Types) +{-# NOINLINE sem_Types_Cons #-} +sem_Types_Cons :: T_Type -> T_Types -> T_Types +sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _hdX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) + _tlX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) + (T_Type_vOut163 _hdIself) = inv_Type_s164 _hdX164 (T_Type_vIn163 ) + (T_Types_vOut166 _tlIself) = inv_Types_s167 _tlX167 (T_Types_vIn166 ) + _self = rule529 _hdIself _tlIself + _lhsOself :: Types + _lhsOself = rule530 _self + __result_ = T_Types_vOut166 _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule529 #-} + rule529 = \ ((_hdIself) :: Type) ((_tlIself) :: Types) -> + (:) _hdIself _tlIself + {-# INLINE rule530 #-} + rule530 = \ _self -> + _self +{-# NOINLINE sem_Types_Nil #-} +sem_Types_Nil :: T_Types +sem_Types_Nil = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _self = rule531 () + _lhsOself :: Types + _lhsOself = rule532 _self + __result_ = T_Types_vOut166 _lhsOself + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule531 #-} + rule531 = \ (_ :: ()) -> + [] + {-# INLINE rule532 #-} + rule532 = \ _self -> + _self diff --git a/src/Helium/Syntax/UHA_Pretty.ag b/src/Helium/Syntax/UHA_Pretty.ag new file mode 100644 --- /dev/null +++ b/src/Helium/Syntax/UHA_Pretty.ag @@ -0,0 +1,777 @@ +INCLUDE "UHA_Syntax.ag" + +imports{ +-- Below two imports are to avoid clashes of "list" as used by the AG system. +-- Effectively, only list from the imported library needs to be qualified. +import Text.PrettyPrint.Leijen hiding (list) +import qualified Text.PrettyPrint.Leijen as PPrint +import Data.Char +import Top.Types (isTupleConstructor) + +import Helium.Syntax.UHA_Syntax +import Helium.Utils.Utils (internalError, hole) + +} + +{ +intErr :: String -> String -> a +intErr = internalError "UHA_Pretty" + +opt :: Maybe Doc -> Doc +opt = maybe empty id + +parensIf, backQuotesIf :: Bool -> Doc -> Doc +parensIf p n = if p then parens n else n +backQuotesIf p n = if p then text "`" <> n <> text "`" else n + +parensIfList :: [Bool] -> [Doc] -> [Doc] +parensIfList ps ns = map (uncurry parensIf) (zip ps ns) + +tupled1 :: [Doc] -> Doc +tupled1 [] = empty +tupled1 xs = tupled xs + +tupled2 :: [Doc] -> Doc +tupled2 [] = empty +tupled2 xs = tupledUnit xs + +tupledUnit :: [Doc] -> Doc +tupledUnit [x] = x +tupledUnit xs = tupled xs + +commas :: [Doc] -> Doc +commas docs = + hcat (punctuate (comma <+> empty) docs) + +utrechtList :: Doc -> Doc -> [Doc] -> Doc +utrechtList _ _ [] = empty +utrechtList start end (d:ds) = + let utrechtList' [] = end + utrechtList' (doc:docs) = comma <+> doc <$> utrechtList' docs + in + start <+> d <$> utrechtList' ds + +} + +ATTR + Module Export Body + ImportDeclaration ImportSpecification Import Declaration Fixity + Type SimpleType ContextItem + Constructor + FieldDeclaration + AnnotatedType + Expression + Statement + Qualifier + Alternative + RecordExpressionBinding RecordPatternBinding + FunctionBinding LeftHandSide + Pattern + Literal + Name + Range Position + [ + | + | text : Doc + ] + +ATTR GuardedExpression RightHandSide + [ + | + | text : { Doc -> Doc } + ] + +ATTR GuardedExpressions + [ + | + | text USE { : } { [] } : { [ Doc -> Doc ] } + ] + +ATTR + Constructors Exports ImportDeclarations Imports Declarations Types ContextItems + FieldDeclarations AnnotatedTypes Expressions + Statements Qualifiers Alternatives RecordExpressionBindings RecordPatternBindings + FunctionBindings Patterns Names Strings + [ + | + | text USE { : } { [] } : { [ Doc ] } + ] + +ATTR + MaybeExports MaybeDeclarations MaybeNames + [ + | + | text : { Maybe [ Doc ] } + ] + +ATTR + MaybeExpression MaybeName MaybeInt MaybeImportSpecification + [ + | + | text : { Maybe Doc } + ] + +ATTR + Name + [ | | isOperator, isIdentifier, isSpecial USE { (error "Name has no children!") } { False } : Bool ] + +ATTR + Names + [ | | isOperator, isIdentifier, isSpecial USE { : } { [] } : { [Bool] } ] +-- ------------------------------------------------------------------------ +-- -- Modules -- +-- ------------------------------------------------------------------------ + +SEM Module + | Module loc.text = + maybe + id + ( \name body -> + text "module" <+> name <+> + (maybe + (text "where") + (\x -> indent 4 (utrechtList (text "(") (text ")") x <+> text "where")) + @exports.text + ) + <$> empty <$> + body + ) + @name.text + @body.text + -- range : Range + -- name : MaybeName + -- exports : MaybeExports + -- body : Body + +SEM MaybeExports + | Nothing loc.text = Nothing + | Just loc.text = Just @exports.text + -- exports : Exports + +SEM Export + | Variable loc.text = @name.text + -- range : Range + -- name : Name + | TypeOrClass loc.text = @name.text <> maybe empty tupled (@names.text) + -- range : Range + -- name : Name + -- names : MaybeNames -- constructors or field names or class methods + | TypeOrClassComplete loc.text = @name.text + -- range : Range + -- name : Name + | Module loc.text = text "module" <+> @name.text + -- range : Range + -- name : Name -- this is a module name + +SEM MaybeNames + | Nothing loc.text = Nothing + | Just loc.text = Just @names.text + -- names : Names + +-- Since the parser cannot distinguish between types or constructors, +-- or between types and type classes, we do not have different cases (yet?). + +SEM Body + | Hole loc.text = text hole + | Body loc.text = vcat + ( @importdeclarations.text + ++ {-intersperse empty-} @declarations.text + ) + -- range : Range + -- importdeclarations : ImportDeclarations + -- declarations : Declarations + +SEM ImportDeclaration + | Import loc.text = text "import" <+> (if @qualified then (text "qualified" <+>) else id) @name.text <+> maybe empty id @importspecification.text + -- range : Range + -- qualified : Bool + -- name : Name + -- asname : MaybeName + -- importspecification : MaybeImportSpecification + | Empty loc.text = empty + +SEM MaybeImportSpecification + | Nothing loc.text = Nothing + | Just loc.text = Just @importspecification.text + -- importSpecification : ImportSpecification + +SEM ImportSpecification + | Import loc.text = (if @hiding then (text "hiding" <+>) else id) + (tupled @imports.text) + -- range : Range + -- hiding : Bool + -- imports : Imports + +SEM Import + | Variable loc.text = @name.text + -- range : Range + -- name : Name + | TypeOrClass loc.text = @name.text <> maybe empty tupled1 @names.text + -- range : Range + -- name : Name + -- names : Names -- constructors or field names or class methods + | TypeOrClassComplete loc.text = @name.text + -- range : Range + -- name : Name + +-- cf. Export + +-- ------------------------------------------------------------------------ +-- -- Declarations -- +-- ------------------------------------------------------------------------ + +SEM MaybeDeclarations + | Nothing loc.text = Nothing +-- | Just loc.text = Just @declarations.text + | Just loc.text = case filter ((/= "") . show) @declarations.text of + [] -> Nothing + xs -> Just xs + + -- declarations : Declarations + +SEM Declaration {- *** -} + | Hole loc.text = text hole + | Type loc.text = text "type" <+> @simpletype.text <+> text "=" <+> @type.text + -- range : Range + -- simpletype : SimpleType + -- type : Type + | Data loc.text = + text "data" <+> + @contextDoc + <> + @simpletype.text + <$> + (indent 4 $ + vcat + ( text "=" + <+> + head @constructors.text + : map + (text "|" <+>) + (tail @constructors.text) + ++ [@derivingDoc] + ) + ) + loc.contextDoc = case @context.text of + [] -> empty + [x] -> x <+> text "=>" <+> empty + xs -> tupled xs <+> text "=>" <+> empty + loc.derivingDoc = + if null @derivings.text then + empty + else + ( empty + <+> text "deriving" + <+> tupledUnit @derivings.text + ) + -- range : Range {- *** -} + -- context : ContextItems + -- simpletype : SimpleType + -- constructors : Constructors + -- derivings : Names + | Newtype loc.text = text "newtype" + <+> + @contextDoc + <> + @simpletype.text + <+> + @constructor.text + <> + @derivingDoc + loc.contextDoc = case @context.text of + [] -> empty + [x] -> x <+> text "=>" <+> empty + xs -> tupled xs <+> text "=>" <+> empty + loc.derivingDoc = + if null @derivings.text then + empty + else + ( empty + <+> text "deriving" + <+> tupledUnit @derivings.text + ) + -- range : Range + -- context : ContextItems + -- simpletype : SimpleType + -- constructor : Constructor -- has only one field, no strictness + -- derivings : Names + | Class loc.text = text "{- !!! class decl -}" + -- range : Range + -- context : ContextItems -- is a "simple" context + -- simpletype : SimpleType -- Haskell 98 allows only one variable + -- where : MaybeDeclarations -- cannot have everything + | Instance loc.text = text "{- !!! instance decl -}" + -- range : Range + -- context : ContextItems -- is a "simple" context + -- name : Name + -- types : Types -- Haskell 98 allows only one type + -- that is severely restricted + -- where : MaybeDeclarations -- cannot have everything + | Default loc.text = text "default" <+> tupled @types.text + -- range : Range + -- types : Types -- should be instances of Num +-- | FunctionBindings loc.text = foldl1 (<$>) @bindings.text + | FunctionBindings loc.text = + case filter ((/= "") . show) @bindings.text of -- AG: no eq for doc + [] -> text hole -- empty + xs -> foldl1 (<$>) xs + -- range : Range {- *** -} + -- bindings : FunctionBindings -- should all be for the same function + | PatternBinding loc.text = @pattern.text <+> @righthandside.text (text "=") + -- range : Range + -- pattern : Pattern + -- righthandside : RightHandSide + | TypeSignature loc.text = commas @namesDocs <+> text "::" <+> @type.text + loc.namesDocs = parensIfList @names.isOperator @names.text + -- range : Range + -- names : Names + -- type : Type -- may have context + | Fixity loc.text = @fixity.text <+> @ops + loc.ops = opt @priority.text <+> + commas + (map + (\(n, p) -> if p then + text "`" <> n <> text "`" + else + n + ) + (zip @operators.text @operators.isIdentifier) + ) + -- range : Range + -- fixity : Fixity + -- priority : MaybeInt + -- operators : Names + | Empty loc.text = empty + -- range : Range + +SEM Fixity + | Infixl loc.text = text "infixl" + -- range : Range + | Infixr loc.text = text "infixr" + -- range : Range + | Infix loc.text = text "infix " -- space for alignment with infixl and infixr + -- range : Range + +-- ------------------------------------------------------------------------ +-- -- Types -- +-- ------------------------------------------------------------------------ + +SEM Type {- *** -} + | Application loc.text = if @prefix then + foldl (<+>) @function.text @arguments.text + else if show @function.text == "[]" then + PPrint.list @arguments.text + else if isTupleConstructor (show @function.text) then + tupled @arguments.text + else + case @arguments.text of + [a, b] -> a <+> @function.text <+> b + _ -> text "{- error: Unknown special application notation -}" + -- range : Range + -- prefix : Bool + -- function : Type + -- arguments : Types + | Variable loc.text = @name.text {- *** -} + -- range : Range + -- name : Name + | Constructor loc.text = @name.text {- *** -} + -- range : Range + -- name : Name + | Qualified loc.text = case @context.text of + [ct] -> ct <+> text "=>" <+> @type.text + cts -> parens (commas cts) <+> text "=>" <+> @type.text + -- range : Range + -- context : ContextItems + -- type : Type + | Forall loc.text = foldl (<+>) (text "forall") @typevariables.text <> text "." <> @type.text + -- range : Range + -- typevariables : Names forall a b . Num a => a + -- type : Type + | Exists loc.text = foldl (<+>) (text "exists") @typevariables.text <> text "." <> @type.text + -- range : Range + -- typevariables : Names + -- type : Type + | Parenthesized loc.text = parens @type.text + -- range : Range + -- type : Type + +SEM SimpleType + | SimpleType loc.text = foldl (<+>) @name.text @typevariables.text + -- name : Name + -- typevariables : Names + +SEM ContextItem + | ContextItem loc.text = @name.text <+> head @types.text -- no parens because it is always a var + -- range : Range + -- name : Name -- that is the class + -- types : Types -- in Haskell 98, this is only one type + +SEM Constructor + | Constructor loc.text = foldl (<+>) (parensIf @constructor.isOperator @constructor.text) @types.text + -- range : Range + -- constructor : Name + -- types : AnnotatedTypes + | Infix loc.text = @leftType.text <+> @constructorOperator.text <+> @rightType.text + -- range : Range + -- leftType : AnnotatedType + -- constructorOperator : Name + -- rightType : AnnotatedType + | Record loc.text = text "{- !!! record constructor -}" + -- range : Range + -- constructor : Name + -- fieldDeclarations : FieldDeclarations + +SEM FieldDeclaration + | FieldDeclaration loc.text = text "{- !!! field declaration -}" + -- range : Range + -- names : Names + -- type : AnnotatedType + +SEM AnnotatedType + | AnnotatedType loc.text = (if @strict then (text "!" <+>) else id) @type.text -- ToDo: or _Type? + -- range : Range + -- strict : Bool + -- type : Type + +-- ------------------------------------------------------------------------ +-- -- Expressions -- +-- ------------------------------------------------------------------------ + +SEM MaybeExpression + | Nothing loc.text = Nothing + | Just loc.text = Just @expression.text + -- expression : Expression + +SEM Expression {- *** -} + | Hole loc.text = text hole {- *** -} + -- range : Range + -- id : Integer + | Literal loc.text = @literal.text {- *** -} + -- range : Range + -- literal : Literal + | Variable loc.text = @name.text {- *** -} + -- range : Range + -- name : Name + | Constructor loc.text = @name.text {- *** -} + -- range : Range + -- name : Name + | Parenthesized loc.text = parens @expression.text + -- range : Range + -- expression : Expression + | NormalApplication loc.text = foldl (<+>) @function.text @arguments.text {- *** -} + -- range : Range + -- function : Expression + -- arguments : Expressions + | InfixApplication loc.text = let f [] m = m + f (c:cs) m = if isAlpha c && all (\ch -> ch == '_' || ch == '\'' || isAlphaNum ch) cs then char '`' <> m <> char '`' else m + in + case (@leftExpression.text, @rightExpression.text) of + (Nothing, Nothing) -> + parens @operator.text + (Just l , Nothing) -> + parens (l <+> @operator.text) + (Nothing, Just r ) -> + parens (@operator.text <+> r) + (Just l , Just r ) -> + l + <+> + f (show @operator.text) @operator.text + <+> + r + -- range : Range + -- leftExpression : MaybeExpression + -- operator : Expression + -- rightExpression : MaybeExpression + | If loc.text = text "if" <+> @guardExpression.text <$> + indent 4 (text "then" <+> @thenExpression.text <$> + text "else" <+> @elseExpression.text) + -- range : Range + -- guardExpression : Expression + -- thenExpression : Expression + -- elseExpression : Expression + | Lambda loc.text = text "\\" <+> foldl1 (<+>) @patterns.text <+> text "->" <+> @expression.text + -- range : Range + -- patterns : Patterns + -- expression : Expression + | Case loc.text = (text "case" <+> @expression.text <+> text "of" <$> + (indent 4 $ vcat @alternatives.text) <$> empty + ) + -- range : Range + -- expression : Expression + -- alternatives : Alternatives + -- | Let loc.text = align (text "let"<+> align (vcat @declarations.text) <$> + -- text "in" <+> @expression.text) <$> empty + | Let loc.text = (text "let"<$> + (indent 4 $ vcat @declarations.text) <+> + text "in" <$> + (indent 4 $ @expression.text) + ) <$> empty + -- range : Range + -- declarations : Declarations + -- expression : Expression + | Do loc.text = text "do" <$> (indent 4 $ vcat @statements.text) <$> empty + -- range : Range + -- statements : Statements + | List loc.text = PPrint.list @expressions.text + -- range : Range + -- expressions : Expressions + | Tuple loc.text = tupled @expressions.text + -- range : Range + -- expressions : Expressions + | Comprehension loc.text = text "[" <+> @expression.text <+> + text "|" <+> commas @qualifiers.text <+> text "]" + -- range : Range + -- expression : Expression + -- qualifiers : Qualifiers + | Typed loc.text = @expression.text <+> text "::" <+> @type.text {- ??? -} + -- range : Range + -- expression : Expression + -- type : Type + | RecordConstruction loc.text = intErr "Expression" "record construction" + -- range : Range + -- name : Name + -- recordExpressionBindings : RecordExpressionBindings + | RecordUpdate loc.text = intErr "Expression" "record update" + -- range : Range + -- expression : Expression + -- recordExpressionBindings : RecordExpressionBindings + | Enum loc.text = + text "[" <> + @from.text <> + maybe empty (text "," <+>) @then.text <+> + text ".." <+> + opt @to.text <> + text "]" + -- range : Range + -- from : Expression + -- then : MaybeExpression + -- to : MaybeExpression + | Negate loc.text = text "-" <> @expression.text + | NegateFloat loc.text = text "-." <> @expression.text + -- range : Range + -- expression : Expression + +SEM Statement + | Expression loc.text = @expression.text + -- range : Range + -- expression : Expression + | Let loc.text = text "let" <$> (indent 4 $ vcat @declarations.text) + -- range : Range + -- declarations : Declarations + | Generator loc.text = @pattern.text <+> text "<-" <+> @expression.text + -- range : Range + -- pattern : Pattern + -- expression : Expression + | Empty loc.text = empty + -- range : Range + +SEM Qualifier + | Guard loc.text = @guard.text + -- range : Range + -- guard : Expression -- type: Boolean + | Let loc.text = text "let" <$> (indent 4 $ vcat @declarations.text) + -- range : Range + -- declarations : Declarations + | Generator loc.text = @pattern.text <+> text "<-" <+> @expression.text + -- range : Range + -- pattern : Pattern + -- expression : Expression + | Empty loc.text = empty + -- range : Range + +SEM Alternative + | Hole loc.text = text hole + | Alternative loc.text = @pattern.text <$> indent 2 (@righthandside.text (text "->")) + -- range : Range + -- pattern : Pattern + -- righthandside : RightHandSide + | Empty loc.text = empty + -- range : Range + +SEM GuardedExpression -- ToDo: or _Guard? + | GuardedExpression loc.text = \assign -> text "|" <+> @guard.text <+> assign <+> @expression.text + -- range : Range + -- guard : Expression -- type: Boolean + -- expression : Expression + +SEM RecordExpressionBinding + | RecordExpressionBinding loc.text = text "{- !!! record expression binding -}" -- ToDo: or _Binding? + -- range : Range + -- name : Name + -- expression : Expression + +SEM RecordPatternBinding + | RecordPatternBinding loc.text = text "{- !!! record pattern binding -}" -- ToDo: or _Binding? + -- range : Range + -- name : Name + -- pattern : Pattern + +SEM FunctionBinding + | Hole loc.text = empty --text "" + | FunctionBinding loc.text = @lefthandside.text <+> @righthandside.text (text "=") + -- range : Range + -- lefthandside : LeftHandSide + -- righthandside : RightHandSide + +SEM LeftHandSide + | Function loc.text = foldl (<+>) (parensIf @name.isOperator @name.text) @patterns.text + -- range : Range + -- name : Name + -- patterns : Patterns + | Infix loc.text = @leftPattern.text <+> backQuotesIf (not @operator.isOperator) @operator.text <+> @rightPattern.text + -- range : Range + -- leftPattern : Pattern + -- operator : Name + -- rightPattern : Pattern + | Parenthesized loc.text = foldl (<+>) (parens @lefthandside.text) @patterns.text + -- range : Range + -- lefthandside : LeftHandSide + -- patterns : Patterns + +SEM RightHandSide + | Expression + loc.text = \assign -> assign <$> @justText + loc.justText = + indent 4 + ( @expression.text + <> maybe + empty + (\ds -> PPrint.empty <$> text "where" <$> indent 4 (vcat ds)) + @where.text + ) + -- + -- loc.text = \assign -> assign <+> @justText + -- loc.justText = + -- @expression.text + -- <> maybe + -- empty + -- (\ds -> PPrint.empty <$> indent 4 (text "where" <$> indent 4 (vcat ds))) + -- @where.text + -- range : Range + -- expression : Expression + -- where : MaybeDeclarations + | Guarded + loc.text = + \assign -> + ( PPrint.empty + <$> vsep + (zipWith (\f x -> indent 4 (f x)) @guardedexpressions.text (repeat assign)) + <> maybe + empty + (\ds -> PPrint.empty <$> indent 4 (text "where" <$> indent 4 (vcat ds))) + @where.text + ) + -- range : Range + -- guardedexpressions : GuardedExpressions + -- where : MaybeDeclarations + +-- ------------------------------------------------------------------------ +-- -- Patterns -- +-- ------------------------------------------------------------------------ + +SEM Pattern + | Hole loc.text = text hole + | Literal loc.text = @literal.text {- *** -} + -- range : Range + -- literal : Literal + | Variable loc.text = parensIf @name.isOperator @name.text {- *** -} + -- range : Range + -- name : Name + | Constructor loc.text = foldl (<+>) (parensIf @name.isOperator @name.text) @patterns.text {- *** -} + -- range : Range + -- name : Name + -- patterns : Patterns + | Parenthesized loc.text = parens @pattern.text + -- range : Range + -- pattern : Pattern + | InfixConstructor loc.text = @leftPattern.text <+> @constructorOperator.text <+> @rightPattern.text + -- range : Range + -- leftPattern : Pattern + -- constructorOperator : Name + -- rightPattern : Pattern + | List loc.text = PPrint.list @patterns.text + -- range : Range + -- patterns : Patterns + | Tuple loc.text = tupled @patterns.text + -- range : Range + -- patterns : Patterns + | Record loc.text = text "{- !!! record pattern -}" + -- range : Range + -- name : Name + -- recordPatternBindings : RecordPatternBindings + | Negate loc.text = text "-" <> @literal.text + -- range : Range + -- literal : Literal -- only numbers allowed here + | NegateFloat loc.text = text "-." <> @literal.text + -- range : Range + -- literal : Literal -- only numbers allowed here + | As loc.text = @name.text <> text "@" <> @pattern.text {- ??? -} + -- range : Range + -- name : Name + -- pattern : Pattern + | Wildcard loc.text = text "_" + -- range : Range + | Irrefutable loc.text = text "~" <> @pattern.text + -- range : Range + -- pattern : Pattern + | Successor loc.text = @name.text <+> text "+" <+> @literal.text -- n+k patterns + -- range : Range + -- name : Name + -- literal : Literal -- only integers allowed here + +-- ------------------------------------------------------------------------ +-- -- Basics -- +-- ------------------------------------------------------------------------ + +SEM Literal {- *** -} + | Int loc.text = text @value {- *** -} + -- range : Range + -- value : String + | Char loc.text = text ("'" ++ @value ++ "'") + -- range : Range + -- value : String -- without the quotes + | Float loc.text = text @value + -- range : Range + -- value : String + | String loc.text = text ("\"" ++ @value ++ "\"") + -- range : Range + -- value : String -- without the quotes + +SEM MaybeName + | Nothing loc.text = Nothing + | Just loc.text = Just @name.text + -- name : Name + +SEM Name {- *** -} + | Identifier loc.text = text @name {- *** -} + lhs.isIdentifier = True + -- range : Range + -- module : Strings + -- name : String + | Operator loc.text = text @name + lhs.isOperator = True + -- range : Range + -- module : Strings + -- name : String + | Special loc.text = text @name + lhs.isSpecial = True + -- range : Range + -- module : Strings + -- name : String + +SEM MaybeInt + | Nothing loc.text = Nothing + | Just loc.text = Just (int @int) -- int is a pprint util from PPrint.hs + -- int : Int + +SEM Range + | Range loc.text = text "{-" <+> @start.text <+> text ", " <+> @stop.text <+> text "-}" + -- start : Position + -- stop : Position + +SEM Position + | Position loc.text = text @filename <> tupled [int @line, int @column] + -- filename : String + -- line : Int + -- column : Int + | Unknown loc.text = text "Unknown" diff --git a/src/Helium/Syntax/UHA_Pretty.hs b/src/Helium/Syntax/UHA_Pretty.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Syntax/UHA_Pretty.hs @@ -0,0 +1,5736 @@ +{-# LANGUAGE Rank2Types, GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Helium.Syntax.UHA_Pretty where + +-- Below two imports are to avoid clashes of "list" as used by the AG system. +-- Effectively, only list from the imported library needs to be qualified. +import Text.PrettyPrint.Leijen hiding (list) +import qualified Text.PrettyPrint.Leijen as PPrint +import Data.Char +import Top.Types (isTupleConstructor) + +import Helium.Syntax.UHA_Syntax +import Helium.Utils.Utils (internalError, hole) + +import Control.Monad.Identity (Identity) +import qualified Control.Monad.Identity + +intErr :: String -> String -> a +intErr = internalError "UHA_Pretty" + +opt :: Maybe Doc -> Doc +opt = maybe empty id + +parensIf, backQuotesIf :: Bool -> Doc -> Doc +parensIf p n = if p then parens n else n +backQuotesIf p n = if p then text "`" <> n <> text "`" else n + +parensIfList :: [Bool] -> [Doc] -> [Doc] +parensIfList ps ns = map (uncurry parensIf) (zip ps ns) + +tupled1 :: [Doc] -> Doc +tupled1 [] = empty +tupled1 xs = tupled xs + +tupled2 :: [Doc] -> Doc +tupled2 [] = empty +tupled2 xs = tupledUnit xs + +tupledUnit :: [Doc] -> Doc +tupledUnit [x] = x +tupledUnit xs = tupled xs + +commas :: [Doc] -> Doc +commas docs = + hcat (punctuate (comma <+> empty) docs) + +utrechtList :: Doc -> Doc -> [Doc] -> Doc +utrechtList _ _ [] = empty +utrechtList start end (d:ds) = + let utrechtList' [] = end + utrechtList' (doc:docs) = comma <+> doc <$> utrechtList' docs + in + start <+> d <$> utrechtList' ds + +-- Alternative ------------------------------------------------- +-- wrapper +data Inh_Alternative = Inh_Alternative { } +data Syn_Alternative = Syn_Alternative { text_Syn_Alternative :: (Doc) } +{-# INLINABLE wrap_Alternative #-} +wrap_Alternative :: T_Alternative -> Inh_Alternative -> (Syn_Alternative ) +wrap_Alternative (T_Alternative act) (Inh_Alternative ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternative_vIn1 + (T_Alternative_vOut1 _lhsOtext) <- return (inv_Alternative_s2 sem arg) + return (Syn_Alternative _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Alternative #-} +sem_Alternative :: Alternative -> T_Alternative +sem_Alternative ( Alternative_Hole range_ id_ ) = sem_Alternative_Hole ( sem_Range range_ ) id_ +sem_Alternative ( Alternative_Feedback range_ feedback_ alternative_ ) = sem_Alternative_Feedback ( sem_Range range_ ) feedback_ ( sem_Alternative alternative_ ) +sem_Alternative ( Alternative_Alternative range_ pattern_ righthandside_ ) = sem_Alternative_Alternative ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Alternative ( Alternative_Empty range_ ) = sem_Alternative_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Alternative = T_Alternative { + attach_T_Alternative :: Identity (T_Alternative_s2 ) + } +newtype T_Alternative_s2 = C_Alternative_s2 { + inv_Alternative_s2 :: (T_Alternative_v1 ) + } +data T_Alternative_s3 = C_Alternative_s3 +type T_Alternative_v1 = (T_Alternative_vIn1 ) -> (T_Alternative_vOut1 ) +data T_Alternative_vIn1 = T_Alternative_vIn1 +data T_Alternative_vOut1 = T_Alternative_vOut1 (Doc) +{-# NOINLINE sem_Alternative_Hole #-} +sem_Alternative_Hole :: T_Range -> (Integer) -> T_Alternative +sem_Alternative_Hole arg_range_ _ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule0 () + _lhsOtext :: Doc + _lhsOtext = rule1 _text + __result_ = T_Alternative_vOut1 _lhsOtext + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule0 #-} + rule0 = \ (_ :: ()) -> + text hole + {-# INLINE rule1 #-} + rule1 = \ _text -> + _text +{-# NOINLINE sem_Alternative_Feedback #-} +sem_Alternative_Feedback :: T_Range -> (String) -> T_Alternative -> T_Alternative +sem_Alternative_Feedback arg_range_ _ arg_alternative_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _alternativeX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_alternative_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Alternative_vOut1 _alternativeItext) = inv_Alternative_s2 _alternativeX2 (T_Alternative_vIn1 ) + _lhsOtext :: Doc + _lhsOtext = rule2 _alternativeItext + __result_ = T_Alternative_vOut1 _lhsOtext + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule2 #-} + rule2 = \ ((_alternativeItext) :: Doc) -> + _alternativeItext +{-# NOINLINE sem_Alternative_Alternative #-} +sem_Alternative_Alternative :: T_Range -> T_Pattern -> T_RightHandSide -> T_Alternative +sem_Alternative_Alternative arg_range_ arg_pattern_ arg_righthandside_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternItext) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_RightHandSide_vOut148 _righthandsideItext) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 ) + _text = rule3 _patternItext _righthandsideItext + _lhsOtext :: Doc + _lhsOtext = rule4 _text + __result_ = T_Alternative_vOut1 _lhsOtext + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule3 #-} + rule3 = \ ((_patternItext) :: Doc) ((_righthandsideItext) :: Doc -> Doc ) -> + _patternItext <$> indent 2 (_righthandsideItext (text "->")) + {-# INLINE rule4 #-} + rule4 = \ _text -> + _text +{-# NOINLINE sem_Alternative_Empty #-} +sem_Alternative_Empty :: T_Range -> T_Alternative +sem_Alternative_Empty arg_range_ = T_Alternative (return st2) where + {-# NOINLINE st2 #-} + st2 = let + v1 :: T_Alternative_v1 + v1 = \ (T_Alternative_vIn1 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule5 () + _lhsOtext :: Doc + _lhsOtext = rule6 _text + __result_ = T_Alternative_vOut1 _lhsOtext + in __result_ ) + in C_Alternative_s2 v1 + {-# INLINE rule5 #-} + rule5 = \ (_ :: ()) -> + empty + {-# INLINE rule6 #-} + rule6 = \ _text -> + _text + +-- Alternatives ------------------------------------------------ +-- wrapper +data Inh_Alternatives = Inh_Alternatives { } +data Syn_Alternatives = Syn_Alternatives { text_Syn_Alternatives :: ( [ Doc ] ) } +{-# INLINABLE wrap_Alternatives #-} +wrap_Alternatives :: T_Alternatives -> Inh_Alternatives -> (Syn_Alternatives ) +wrap_Alternatives (T_Alternatives act) (Inh_Alternatives ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Alternatives_vIn4 + (T_Alternatives_vOut4 _lhsOtext) <- return (inv_Alternatives_s5 sem arg) + return (Syn_Alternatives _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Alternatives #-} +sem_Alternatives :: Alternatives -> T_Alternatives +sem_Alternatives list = Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list) + +-- semantic domain +newtype T_Alternatives = T_Alternatives { + attach_T_Alternatives :: Identity (T_Alternatives_s5 ) + } +newtype T_Alternatives_s5 = C_Alternatives_s5 { + inv_Alternatives_s5 :: (T_Alternatives_v4 ) + } +data T_Alternatives_s6 = C_Alternatives_s6 +type T_Alternatives_v4 = (T_Alternatives_vIn4 ) -> (T_Alternatives_vOut4 ) +data T_Alternatives_vIn4 = T_Alternatives_vIn4 +data T_Alternatives_vOut4 = T_Alternatives_vOut4 ( [ Doc ] ) +{-# NOINLINE sem_Alternatives_Cons #-} +sem_Alternatives_Cons :: T_Alternative -> T_Alternatives -> T_Alternatives +sem_Alternatives_Cons arg_hd_ arg_tl_ = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 ) -> ( let + _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Alternative (arg_hd_)) + _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_tl_)) + (T_Alternative_vOut1 _hdItext) = inv_Alternative_s2 _hdX2 (T_Alternative_vIn1 ) + (T_Alternatives_vOut4 _tlItext) = inv_Alternatives_s5 _tlX5 (T_Alternatives_vIn4 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule7 _hdItext _tlItext + __result_ = T_Alternatives_vOut4 _lhsOtext + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule7 #-} + rule7 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_Alternatives_Nil #-} +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = T_Alternatives (return st5) where + {-# NOINLINE st5 #-} + st5 = let + v4 :: T_Alternatives_v4 + v4 = \ (T_Alternatives_vIn4 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule8 () + __result_ = T_Alternatives_vOut4 _lhsOtext + in __result_ ) + in C_Alternatives_s5 v4 + {-# INLINE rule8 #-} + rule8 = \ (_ :: ()) -> + [] + +-- AnnotatedType ----------------------------------------------- +-- wrapper +data Inh_AnnotatedType = Inh_AnnotatedType { } +data Syn_AnnotatedType = Syn_AnnotatedType { text_Syn_AnnotatedType :: (Doc) } +{-# INLINABLE wrap_AnnotatedType #-} +wrap_AnnotatedType :: T_AnnotatedType -> Inh_AnnotatedType -> (Syn_AnnotatedType ) +wrap_AnnotatedType (T_AnnotatedType act) (Inh_AnnotatedType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedType_vIn7 + (T_AnnotatedType_vOut7 _lhsOtext) <- return (inv_AnnotatedType_s8 sem arg) + return (Syn_AnnotatedType _lhsOtext) + ) + +-- cata +{-# INLINE sem_AnnotatedType #-} +sem_AnnotatedType :: AnnotatedType -> T_AnnotatedType +sem_AnnotatedType ( AnnotatedType_AnnotatedType range_ strict_ type_ ) = sem_AnnotatedType_AnnotatedType ( sem_Range range_ ) strict_ ( sem_Type type_ ) + +-- semantic domain +newtype T_AnnotatedType = T_AnnotatedType { + attach_T_AnnotatedType :: Identity (T_AnnotatedType_s8 ) + } +newtype T_AnnotatedType_s8 = C_AnnotatedType_s8 { + inv_AnnotatedType_s8 :: (T_AnnotatedType_v7 ) + } +data T_AnnotatedType_s9 = C_AnnotatedType_s9 +type T_AnnotatedType_v7 = (T_AnnotatedType_vIn7 ) -> (T_AnnotatedType_vOut7 ) +data T_AnnotatedType_vIn7 = T_AnnotatedType_vIn7 +data T_AnnotatedType_vOut7 = T_AnnotatedType_vOut7 (Doc) +{-# NOINLINE sem_AnnotatedType_AnnotatedType #-} +sem_AnnotatedType_AnnotatedType :: T_Range -> (Bool) -> T_Type -> T_AnnotatedType +sem_AnnotatedType_AnnotatedType arg_range_ arg_strict_ arg_type_ = T_AnnotatedType (return st8) where + {-# NOINLINE st8 #-} + st8 = let + v7 :: T_AnnotatedType_v7 + v7 = \ (T_AnnotatedType_vIn7 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeItext) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _text = rule9 _typeItext arg_strict_ + _lhsOtext :: Doc + _lhsOtext = rule10 _text + __result_ = T_AnnotatedType_vOut7 _lhsOtext + in __result_ ) + in C_AnnotatedType_s8 v7 + {-# INLINE rule9 #-} + rule9 = \ ((_typeItext) :: Doc) strict_ -> + (if strict_ then (text "!" <+>) else id) _typeItext + {-# INLINE rule10 #-} + rule10 = \ _text -> + _text + +-- AnnotatedTypes ---------------------------------------------- +-- wrapper +data Inh_AnnotatedTypes = Inh_AnnotatedTypes { } +data Syn_AnnotatedTypes = Syn_AnnotatedTypes { text_Syn_AnnotatedTypes :: ( [ Doc ] ) } +{-# INLINABLE wrap_AnnotatedTypes #-} +wrap_AnnotatedTypes :: T_AnnotatedTypes -> Inh_AnnotatedTypes -> (Syn_AnnotatedTypes ) +wrap_AnnotatedTypes (T_AnnotatedTypes act) (Inh_AnnotatedTypes ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_AnnotatedTypes_vIn10 + (T_AnnotatedTypes_vOut10 _lhsOtext) <- return (inv_AnnotatedTypes_s11 sem arg) + return (Syn_AnnotatedTypes _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_AnnotatedTypes #-} +sem_AnnotatedTypes :: AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes list = Prelude.foldr sem_AnnotatedTypes_Cons sem_AnnotatedTypes_Nil (Prelude.map sem_AnnotatedType list) + +-- semantic domain +newtype T_AnnotatedTypes = T_AnnotatedTypes { + attach_T_AnnotatedTypes :: Identity (T_AnnotatedTypes_s11 ) + } +newtype T_AnnotatedTypes_s11 = C_AnnotatedTypes_s11 { + inv_AnnotatedTypes_s11 :: (T_AnnotatedTypes_v10 ) + } +data T_AnnotatedTypes_s12 = C_AnnotatedTypes_s12 +type T_AnnotatedTypes_v10 = (T_AnnotatedTypes_vIn10 ) -> (T_AnnotatedTypes_vOut10 ) +data T_AnnotatedTypes_vIn10 = T_AnnotatedTypes_vIn10 +data T_AnnotatedTypes_vOut10 = T_AnnotatedTypes_vOut10 ( [ Doc ] ) +{-# NOINLINE sem_AnnotatedTypes_Cons #-} +sem_AnnotatedTypes_Cons :: T_AnnotatedType -> T_AnnotatedTypes -> T_AnnotatedTypes +sem_AnnotatedTypes_Cons arg_hd_ arg_tl_ = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _hdX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_hd_)) + _tlX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_tl_)) + (T_AnnotatedType_vOut7 _hdItext) = inv_AnnotatedType_s8 _hdX8 (T_AnnotatedType_vIn7 ) + (T_AnnotatedTypes_vOut10 _tlItext) = inv_AnnotatedTypes_s11 _tlX11 (T_AnnotatedTypes_vIn10 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule11 _hdItext _tlItext + __result_ = T_AnnotatedTypes_vOut10 _lhsOtext + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule11 #-} + rule11 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_AnnotatedTypes_Nil #-} +sem_AnnotatedTypes_Nil :: T_AnnotatedTypes +sem_AnnotatedTypes_Nil = T_AnnotatedTypes (return st11) where + {-# NOINLINE st11 #-} + st11 = let + v10 :: T_AnnotatedTypes_v10 + v10 = \ (T_AnnotatedTypes_vIn10 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule12 () + __result_ = T_AnnotatedTypes_vOut10 _lhsOtext + in __result_ ) + in C_AnnotatedTypes_s11 v10 + {-# INLINE rule12 #-} + rule12 = \ (_ :: ()) -> + [] + +-- Body -------------------------------------------------------- +-- wrapper +data Inh_Body = Inh_Body { } +data Syn_Body = Syn_Body { text_Syn_Body :: (Doc) } +{-# INLINABLE wrap_Body #-} +wrap_Body :: T_Body -> Inh_Body -> (Syn_Body ) +wrap_Body (T_Body act) (Inh_Body ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Body_vIn13 + (T_Body_vOut13 _lhsOtext) <- return (inv_Body_s14 sem arg) + return (Syn_Body _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Body #-} +sem_Body :: Body -> T_Body +sem_Body ( Body_Hole range_ id_ ) = sem_Body_Hole ( sem_Range range_ ) id_ +sem_Body ( Body_Body range_ importdeclarations_ declarations_ ) = sem_Body_Body ( sem_Range range_ ) ( sem_ImportDeclarations importdeclarations_ ) ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_Body = T_Body { + attach_T_Body :: Identity (T_Body_s14 ) + } +newtype T_Body_s14 = C_Body_s14 { + inv_Body_s14 :: (T_Body_v13 ) + } +data T_Body_s15 = C_Body_s15 +type T_Body_v13 = (T_Body_vIn13 ) -> (T_Body_vOut13 ) +data T_Body_vIn13 = T_Body_vIn13 +data T_Body_vOut13 = T_Body_vOut13 (Doc) +{-# NOINLINE sem_Body_Hole #-} +sem_Body_Hole :: T_Range -> (Integer) -> T_Body +sem_Body_Hole arg_range_ _ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule13 () + _lhsOtext :: Doc + _lhsOtext = rule14 _text + __result_ = T_Body_vOut13 _lhsOtext + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule13 #-} + rule13 = \ (_ :: ()) -> + text hole + {-# INLINE rule14 #-} + rule14 = \ _text -> + _text +{-# NOINLINE sem_Body_Body #-} +sem_Body_Body :: T_Range -> T_ImportDeclarations -> T_Declarations -> T_Body +sem_Body_Body arg_range_ arg_importdeclarations_ arg_declarations_ = T_Body (return st14) where + {-# NOINLINE st14 #-} + st14 = let + v13 :: T_Body_v13 + v13 = \ (T_Body_vIn13 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importdeclarationsX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_importdeclarations_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ImportDeclarations_vOut73 _importdeclarationsItext) = inv_ImportDeclarations_s74 _importdeclarationsX74 (T_ImportDeclarations_vIn73 ) + (T_Declarations_vOut31 _declarationsItext) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _text = rule15 _declarationsItext _importdeclarationsItext + _lhsOtext :: Doc + _lhsOtext = rule16 _text + __result_ = T_Body_vOut13 _lhsOtext + in __result_ ) + in C_Body_s14 v13 + {-# INLINE rule15 #-} + rule15 = \ ((_declarationsItext) :: [ Doc ] ) ((_importdeclarationsItext) :: [ Doc ] ) -> + vcat + ( _importdeclarationsItext + ++ _declarationsItext + ) + {-# INLINE rule16 #-} + rule16 = \ _text -> + _text + +-- Constructor ------------------------------------------------- +-- wrapper +data Inh_Constructor = Inh_Constructor { } +data Syn_Constructor = Syn_Constructor { text_Syn_Constructor :: (Doc) } +{-# INLINABLE wrap_Constructor #-} +wrap_Constructor :: T_Constructor -> Inh_Constructor -> (Syn_Constructor ) +wrap_Constructor (T_Constructor act) (Inh_Constructor ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructor_vIn16 + (T_Constructor_vOut16 _lhsOtext) <- return (inv_Constructor_s17 sem arg) + return (Syn_Constructor _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Constructor #-} +sem_Constructor :: Constructor -> T_Constructor +sem_Constructor ( Constructor_Constructor range_ constructor_ types_ ) = sem_Constructor_Constructor ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_AnnotatedTypes types_ ) +sem_Constructor ( Constructor_Infix range_ leftType_ constructorOperator_ rightType_ ) = sem_Constructor_Infix ( sem_Range range_ ) ( sem_AnnotatedType leftType_ ) ( sem_Name constructorOperator_ ) ( sem_AnnotatedType rightType_ ) +sem_Constructor ( Constructor_Record range_ constructor_ fieldDeclarations_ ) = sem_Constructor_Record ( sem_Range range_ ) ( sem_Name constructor_ ) ( sem_FieldDeclarations fieldDeclarations_ ) + +-- semantic domain +newtype T_Constructor = T_Constructor { + attach_T_Constructor :: Identity (T_Constructor_s17 ) + } +newtype T_Constructor_s17 = C_Constructor_s17 { + inv_Constructor_s17 :: (T_Constructor_v16 ) + } +data T_Constructor_s18 = C_Constructor_s18 +type T_Constructor_v16 = (T_Constructor_vIn16 ) -> (T_Constructor_vOut16 ) +data T_Constructor_vIn16 = T_Constructor_vIn16 +data T_Constructor_vOut16 = T_Constructor_vOut16 (Doc) +{-# NOINLINE sem_Constructor_Constructor #-} +sem_Constructor_Constructor :: T_Range -> T_Name -> T_AnnotatedTypes -> T_Constructor +sem_Constructor_Constructor arg_range_ arg_constructor_ arg_types_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _typesX11 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedTypes (arg_types_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIisIdentifier _constructorIisOperator _constructorIisSpecial _constructorItext) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_AnnotatedTypes_vOut10 _typesItext) = inv_AnnotatedTypes_s11 _typesX11 (T_AnnotatedTypes_vIn10 ) + _text = rule17 _constructorIisOperator _constructorItext _typesItext + _lhsOtext :: Doc + _lhsOtext = rule18 _text + __result_ = T_Constructor_vOut16 _lhsOtext + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule17 #-} + rule17 = \ ((_constructorIisOperator) :: Bool) ((_constructorItext) :: Doc) ((_typesItext) :: [ Doc ] ) -> + foldl (<+>) (parensIf _constructorIisOperator _constructorItext) _typesItext + {-# INLINE rule18 #-} + rule18 = \ _text -> + _text +{-# NOINLINE sem_Constructor_Infix #-} +sem_Constructor_Infix :: T_Range -> T_AnnotatedType -> T_Name -> T_AnnotatedType -> T_Constructor +sem_Constructor_Infix arg_range_ arg_leftType_ arg_constructorOperator_ arg_rightType_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_leftType_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightTypeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_rightType_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_AnnotatedType_vOut7 _leftTypeItext) = inv_AnnotatedType_s8 _leftTypeX8 (T_AnnotatedType_vIn7 ) + (T_Name_vOut112 _constructorOperatorIisIdentifier _constructorOperatorIisOperator _constructorOperatorIisSpecial _constructorOperatorItext) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_AnnotatedType_vOut7 _rightTypeItext) = inv_AnnotatedType_s8 _rightTypeX8 (T_AnnotatedType_vIn7 ) + _text = rule19 _constructorOperatorItext _leftTypeItext _rightTypeItext + _lhsOtext :: Doc + _lhsOtext = rule20 _text + __result_ = T_Constructor_vOut16 _lhsOtext + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule19 #-} + rule19 = \ ((_constructorOperatorItext) :: Doc) ((_leftTypeItext) :: Doc) ((_rightTypeItext) :: Doc) -> + _leftTypeItext <+> _constructorOperatorItext <+> _rightTypeItext + {-# INLINE rule20 #-} + rule20 = \ _text -> + _text +{-# NOINLINE sem_Constructor_Record #-} +sem_Constructor_Record :: T_Range -> T_Name -> T_FieldDeclarations -> T_Constructor +sem_Constructor_Record arg_range_ arg_constructor_ arg_fieldDeclarations_ = T_Constructor (return st17) where + {-# NOINLINE st17 #-} + st17 = let + v16 :: T_Constructor_v16 + v16 = \ (T_Constructor_vIn16 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _constructorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructor_)) + _fieldDeclarationsX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_fieldDeclarations_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _constructorIisIdentifier _constructorIisOperator _constructorIisSpecial _constructorItext) = inv_Name_s113 _constructorX113 (T_Name_vIn112 ) + (T_FieldDeclarations_vOut49 _fieldDeclarationsItext) = inv_FieldDeclarations_s50 _fieldDeclarationsX50 (T_FieldDeclarations_vIn49 ) + _text = rule21 () + _lhsOtext :: Doc + _lhsOtext = rule22 _text + __result_ = T_Constructor_vOut16 _lhsOtext + in __result_ ) + in C_Constructor_s17 v16 + {-# INLINE rule21 #-} + rule21 = \ (_ :: ()) -> + text "{- !!! record constructor -}" + {-# INLINE rule22 #-} + rule22 = \ _text -> + _text + +-- Constructors ------------------------------------------------ +-- wrapper +data Inh_Constructors = Inh_Constructors { } +data Syn_Constructors = Syn_Constructors { text_Syn_Constructors :: ( [ Doc ] ) } +{-# INLINABLE wrap_Constructors #-} +wrap_Constructors :: T_Constructors -> Inh_Constructors -> (Syn_Constructors ) +wrap_Constructors (T_Constructors act) (Inh_Constructors ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Constructors_vIn19 + (T_Constructors_vOut19 _lhsOtext) <- return (inv_Constructors_s20 sem arg) + return (Syn_Constructors _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Constructors #-} +sem_Constructors :: Constructors -> T_Constructors +sem_Constructors list = Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list) + +-- semantic domain +newtype T_Constructors = T_Constructors { + attach_T_Constructors :: Identity (T_Constructors_s20 ) + } +newtype T_Constructors_s20 = C_Constructors_s20 { + inv_Constructors_s20 :: (T_Constructors_v19 ) + } +data T_Constructors_s21 = C_Constructors_s21 +type T_Constructors_v19 = (T_Constructors_vIn19 ) -> (T_Constructors_vOut19 ) +data T_Constructors_vIn19 = T_Constructors_vIn19 +data T_Constructors_vOut19 = T_Constructors_vOut19 ( [ Doc ] ) +{-# NOINLINE sem_Constructors_Cons #-} +sem_Constructors_Cons :: T_Constructor -> T_Constructors -> T_Constructors +sem_Constructors_Cons arg_hd_ arg_tl_ = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 ) -> ( let + _hdX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_hd_)) + _tlX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_tl_)) + (T_Constructor_vOut16 _hdItext) = inv_Constructor_s17 _hdX17 (T_Constructor_vIn16 ) + (T_Constructors_vOut19 _tlItext) = inv_Constructors_s20 _tlX20 (T_Constructors_vIn19 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule23 _hdItext _tlItext + __result_ = T_Constructors_vOut19 _lhsOtext + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule23 #-} + rule23 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_Constructors_Nil #-} +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = T_Constructors (return st20) where + {-# NOINLINE st20 #-} + st20 = let + v19 :: T_Constructors_v19 + v19 = \ (T_Constructors_vIn19 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule24 () + __result_ = T_Constructors_vOut19 _lhsOtext + in __result_ ) + in C_Constructors_s20 v19 + {-# INLINE rule24 #-} + rule24 = \ (_ :: ()) -> + [] + +-- ContextItem ------------------------------------------------- +-- wrapper +data Inh_ContextItem = Inh_ContextItem { } +data Syn_ContextItem = Syn_ContextItem { text_Syn_ContextItem :: (Doc) } +{-# INLINABLE wrap_ContextItem #-} +wrap_ContextItem :: T_ContextItem -> Inh_ContextItem -> (Syn_ContextItem ) +wrap_ContextItem (T_ContextItem act) (Inh_ContextItem ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItem_vIn22 + (T_ContextItem_vOut22 _lhsOtext) <- return (inv_ContextItem_s23 sem arg) + return (Syn_ContextItem _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_ContextItem #-} +sem_ContextItem :: ContextItem -> T_ContextItem +sem_ContextItem ( ContextItem_ContextItem range_ name_ types_ ) = sem_ContextItem_ContextItem ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Types types_ ) + +-- semantic domain +newtype T_ContextItem = T_ContextItem { + attach_T_ContextItem :: Identity (T_ContextItem_s23 ) + } +newtype T_ContextItem_s23 = C_ContextItem_s23 { + inv_ContextItem_s23 :: (T_ContextItem_v22 ) + } +data T_ContextItem_s24 = C_ContextItem_s24 +type T_ContextItem_v22 = (T_ContextItem_vIn22 ) -> (T_ContextItem_vOut22 ) +data T_ContextItem_vIn22 = T_ContextItem_vIn22 +data T_ContextItem_vOut22 = T_ContextItem_vOut22 (Doc) +{-# NOINLINE sem_ContextItem_ContextItem #-} +sem_ContextItem_ContextItem :: T_Range -> T_Name -> T_Types -> T_ContextItem +sem_ContextItem_ContextItem arg_range_ arg_name_ arg_types_ = T_ContextItem (return st23) where + {-# NOINLINE st23 #-} + st23 = let + v22 :: T_ContextItem_v22 + v22 = \ (T_ContextItem_vIn22 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesItext) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _text = rule25 _nameItext _typesItext + _lhsOtext :: Doc + _lhsOtext = rule26 _text + __result_ = T_ContextItem_vOut22 _lhsOtext + in __result_ ) + in C_ContextItem_s23 v22 + {-# INLINE rule25 #-} + rule25 = \ ((_nameItext) :: Doc) ((_typesItext) :: [ Doc ] ) -> + _nameItext <+> head _typesItext + {-# INLINE rule26 #-} + rule26 = \ _text -> + _text + +-- ContextItems ------------------------------------------------ +-- wrapper +data Inh_ContextItems = Inh_ContextItems { } +data Syn_ContextItems = Syn_ContextItems { text_Syn_ContextItems :: ( [ Doc ] ) } +{-# INLINABLE wrap_ContextItems #-} +wrap_ContextItems :: T_ContextItems -> Inh_ContextItems -> (Syn_ContextItems ) +wrap_ContextItems (T_ContextItems act) (Inh_ContextItems ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ContextItems_vIn25 + (T_ContextItems_vOut25 _lhsOtext) <- return (inv_ContextItems_s26 sem arg) + return (Syn_ContextItems _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_ContextItems #-} +sem_ContextItems :: ContextItems -> T_ContextItems +sem_ContextItems list = Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list) + +-- semantic domain +newtype T_ContextItems = T_ContextItems { + attach_T_ContextItems :: Identity (T_ContextItems_s26 ) + } +newtype T_ContextItems_s26 = C_ContextItems_s26 { + inv_ContextItems_s26 :: (T_ContextItems_v25 ) + } +data T_ContextItems_s27 = C_ContextItems_s27 +type T_ContextItems_v25 = (T_ContextItems_vIn25 ) -> (T_ContextItems_vOut25 ) +data T_ContextItems_vIn25 = T_ContextItems_vIn25 +data T_ContextItems_vOut25 = T_ContextItems_vOut25 ( [ Doc ] ) +{-# NOINLINE sem_ContextItems_Cons #-} +sem_ContextItems_Cons :: T_ContextItem -> T_ContextItems -> T_ContextItems +sem_ContextItems_Cons arg_hd_ arg_tl_ = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _hdX23 = Control.Monad.Identity.runIdentity (attach_T_ContextItem (arg_hd_)) + _tlX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_tl_)) + (T_ContextItem_vOut22 _hdItext) = inv_ContextItem_s23 _hdX23 (T_ContextItem_vIn22 ) + (T_ContextItems_vOut25 _tlItext) = inv_ContextItems_s26 _tlX26 (T_ContextItems_vIn25 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule27 _hdItext _tlItext + __result_ = T_ContextItems_vOut25 _lhsOtext + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule27 #-} + rule27 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_ContextItems_Nil #-} +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = T_ContextItems (return st26) where + {-# NOINLINE st26 #-} + st26 = let + v25 :: T_ContextItems_v25 + v25 = \ (T_ContextItems_vIn25 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule28 () + __result_ = T_ContextItems_vOut25 _lhsOtext + in __result_ ) + in C_ContextItems_s26 v25 + {-# INLINE rule28 #-} + rule28 = \ (_ :: ()) -> + [] + +-- Declaration ------------------------------------------------- +-- wrapper +data Inh_Declaration = Inh_Declaration { } +data Syn_Declaration = Syn_Declaration { text_Syn_Declaration :: (Doc) } +{-# INLINABLE wrap_Declaration #-} +wrap_Declaration :: T_Declaration -> Inh_Declaration -> (Syn_Declaration ) +wrap_Declaration (T_Declaration act) (Inh_Declaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declaration_vIn28 + (T_Declaration_vOut28 _lhsOtext) <- return (inv_Declaration_s29 sem arg) + return (Syn_Declaration _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Declaration #-} +sem_Declaration :: Declaration -> T_Declaration +sem_Declaration ( Declaration_Hole range_ id_ ) = sem_Declaration_Hole ( sem_Range range_ ) id_ +sem_Declaration ( Declaration_Type range_ simpletype_ type_ ) = sem_Declaration_Type ( sem_Range range_ ) ( sem_SimpleType simpletype_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Data range_ context_ simpletype_ constructors_ derivings_ ) = sem_Declaration_Data ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructors constructors_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Newtype range_ context_ simpletype_ constructor_ derivings_ ) = sem_Declaration_Newtype ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_Constructor constructor_ ) ( sem_Names derivings_ ) +sem_Declaration ( Declaration_Class range_ context_ simpletype_ where_ ) = sem_Declaration_Class ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_SimpleType simpletype_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Instance range_ context_ name_ types_ where_ ) = sem_Declaration_Instance ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Name name_ ) ( sem_Types types_ ) ( sem_MaybeDeclarations where_ ) +sem_Declaration ( Declaration_Default range_ types_ ) = sem_Declaration_Default ( sem_Range range_ ) ( sem_Types types_ ) +sem_Declaration ( Declaration_FunctionBindings range_ bindings_ ) = sem_Declaration_FunctionBindings ( sem_Range range_ ) ( sem_FunctionBindings bindings_ ) +sem_Declaration ( Declaration_PatternBinding range_ pattern_ righthandside_ ) = sem_Declaration_PatternBinding ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_RightHandSide righthandside_ ) +sem_Declaration ( Declaration_TypeSignature range_ names_ type_ ) = sem_Declaration_TypeSignature ( sem_Range range_ ) ( sem_Names names_ ) ( sem_Type type_ ) +sem_Declaration ( Declaration_Fixity range_ fixity_ priority_ operators_ ) = sem_Declaration_Fixity ( sem_Range range_ ) ( sem_Fixity fixity_ ) ( sem_MaybeInt priority_ ) ( sem_Names operators_ ) +sem_Declaration ( Declaration_Empty range_ ) = sem_Declaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Declaration = T_Declaration { + attach_T_Declaration :: Identity (T_Declaration_s29 ) + } +newtype T_Declaration_s29 = C_Declaration_s29 { + inv_Declaration_s29 :: (T_Declaration_v28 ) + } +data T_Declaration_s30 = C_Declaration_s30 +type T_Declaration_v28 = (T_Declaration_vIn28 ) -> (T_Declaration_vOut28 ) +data T_Declaration_vIn28 = T_Declaration_vIn28 +data T_Declaration_vOut28 = T_Declaration_vOut28 (Doc) +{-# NOINLINE sem_Declaration_Hole #-} +sem_Declaration_Hole :: T_Range -> (Integer) -> T_Declaration +sem_Declaration_Hole arg_range_ _ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule29 () + _lhsOtext :: Doc + _lhsOtext = rule30 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule29 #-} + rule29 = \ (_ :: ()) -> + text hole + {-# INLINE rule30 #-} + rule30 = \ _text -> + _text +{-# NOINLINE sem_Declaration_Type #-} +sem_Declaration_Type :: T_Range -> T_SimpleType -> T_Type -> T_Declaration +sem_Declaration_Type arg_range_ arg_simpletype_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_SimpleType_vOut151 _simpletypeItext) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Type_vOut163 _typeItext) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _text = rule31 _simpletypeItext _typeItext + _lhsOtext :: Doc + _lhsOtext = rule32 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule31 #-} + rule31 = \ ((_simpletypeItext) :: Doc) ((_typeItext) :: Doc) -> + text "type" <+> _simpletypeItext <+> text "=" <+> _typeItext + {-# INLINE rule32 #-} + rule32 = \ _text -> + _text +{-# NOINLINE sem_Declaration_Data #-} +sem_Declaration_Data :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructors -> T_Names -> T_Declaration +sem_Declaration_Data arg_range_ arg_context_ arg_simpletype_ arg_constructors_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorsX20 = Control.Monad.Identity.runIdentity (attach_T_Constructors (arg_constructors_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextItext) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeItext) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructors_vOut19 _constructorsItext) = inv_Constructors_s20 _constructorsX20 (T_Constructors_vIn19 ) + (T_Names_vOut115 _derivingsIisIdentifier _derivingsIisOperator _derivingsIisSpecial _derivingsItext) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _text = rule33 _constructorsItext _contextDoc _derivingDoc _simpletypeItext + _contextDoc = rule34 _contextItext + _derivingDoc = rule35 _derivingsItext + _lhsOtext :: Doc + _lhsOtext = rule36 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule33 #-} + rule33 = \ ((_constructorsItext) :: [ Doc ] ) _contextDoc _derivingDoc ((_simpletypeItext) :: Doc) -> + text "data" <+> + _contextDoc + <> + _simpletypeItext + <$> + (indent 4 $ + vcat + ( text "=" + <+> + head _constructorsItext + : map + (text "|" <+>) + (tail _constructorsItext) + ++ [_derivingDoc] + ) + ) + {-# INLINE rule34 #-} + rule34 = \ ((_contextItext) :: [ Doc ] ) -> + case _contextItext of + [] -> empty + [x] -> x <+> text "=>" <+> empty + xs -> tupled xs <+> text "=>" <+> empty + {-# INLINE rule35 #-} + rule35 = \ ((_derivingsItext) :: [ Doc ] ) -> + if null _derivingsItext then + empty + else + ( empty + <+> text "deriving" + <+> tupledUnit _derivingsItext + ) + {-# INLINE rule36 #-} + rule36 = \ _text -> + _text +{-# NOINLINE sem_Declaration_Newtype #-} +sem_Declaration_Newtype :: T_Range -> T_ContextItems -> T_SimpleType -> T_Constructor -> T_Names -> T_Declaration +sem_Declaration_Newtype arg_range_ arg_context_ arg_simpletype_ arg_constructor_ arg_derivings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _constructorX17 = Control.Monad.Identity.runIdentity (attach_T_Constructor (arg_constructor_)) + _derivingsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_derivings_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextItext) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeItext) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_Constructor_vOut16 _constructorItext) = inv_Constructor_s17 _constructorX17 (T_Constructor_vIn16 ) + (T_Names_vOut115 _derivingsIisIdentifier _derivingsIisOperator _derivingsIisSpecial _derivingsItext) = inv_Names_s116 _derivingsX116 (T_Names_vIn115 ) + _text = rule37 _constructorItext _contextDoc _derivingDoc _simpletypeItext + _contextDoc = rule38 _contextItext + _derivingDoc = rule39 _derivingsItext + _lhsOtext :: Doc + _lhsOtext = rule40 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule37 #-} + rule37 = \ ((_constructorItext) :: Doc) _contextDoc _derivingDoc ((_simpletypeItext) :: Doc) -> + text "newtype" + <+> + _contextDoc + <> + _simpletypeItext + <+> + _constructorItext + <> + _derivingDoc + {-# INLINE rule38 #-} + rule38 = \ ((_contextItext) :: [ Doc ] ) -> + case _contextItext of + [] -> empty + [x] -> x <+> text "=>" <+> empty + xs -> tupled xs <+> text "=>" <+> empty + {-# INLINE rule39 #-} + rule39 = \ ((_derivingsItext) :: [ Doc ] ) -> + if null _derivingsItext then + empty + else + ( empty + <+> text "deriving" + <+> tupledUnit _derivingsItext + ) + {-# INLINE rule40 #-} + rule40 = \ _text -> + _text +{-# NOINLINE sem_Declaration_Class #-} +sem_Declaration_Class :: T_Range -> T_ContextItems -> T_SimpleType -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Class arg_range_ arg_context_ arg_simpletype_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _simpletypeX152 = Control.Monad.Identity.runIdentity (attach_T_SimpleType (arg_simpletype_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextItext) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_SimpleType_vOut151 _simpletypeItext) = inv_SimpleType_s152 _simpletypeX152 (T_SimpleType_vIn151 ) + (T_MaybeDeclarations_vOut88 _whereItext) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _text = rule41 () + _lhsOtext :: Doc + _lhsOtext = rule42 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule41 #-} + rule41 = \ (_ :: ()) -> + text "{- !!! class decl -}" + {-# INLINE rule42 #-} + rule42 = \ _text -> + _text +{-# NOINLINE sem_Declaration_Instance #-} +sem_Declaration_Instance :: T_Range -> T_ContextItems -> T_Name -> T_Types -> T_MaybeDeclarations -> T_Declaration +sem_Declaration_Instance arg_range_ arg_context_ arg_name_ arg_types_ arg_where_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextItext) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Types_vOut166 _typesItext) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + (T_MaybeDeclarations_vOut88 _whereItext) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _text = rule43 () + _lhsOtext :: Doc + _lhsOtext = rule44 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule43 #-} + rule43 = \ (_ :: ()) -> + text "{- !!! instance decl -}" + {-# INLINE rule44 #-} + rule44 = \ _text -> + _text +{-# NOINLINE sem_Declaration_Default #-} +sem_Declaration_Default :: T_Range -> T_Types -> T_Declaration +sem_Declaration_Default arg_range_ arg_types_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typesX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_types_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Types_vOut166 _typesItext) = inv_Types_s167 _typesX167 (T_Types_vIn166 ) + _text = rule45 _typesItext + _lhsOtext :: Doc + _lhsOtext = rule46 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule45 #-} + rule45 = \ ((_typesItext) :: [ Doc ] ) -> + text "default" <+> tupled _typesItext + {-# INLINE rule46 #-} + rule46 = \ _text -> + _text +{-# NOINLINE sem_Declaration_FunctionBindings #-} +sem_Declaration_FunctionBindings :: T_Range -> T_FunctionBindings -> T_Declaration +sem_Declaration_FunctionBindings arg_range_ arg_bindings_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _bindingsX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_bindings_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBindings_vOut58 _bindingsItext) = inv_FunctionBindings_s59 _bindingsX59 (T_FunctionBindings_vIn58 ) + _text = rule47 _bindingsItext + _lhsOtext :: Doc + _lhsOtext = rule48 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule47 #-} + rule47 = \ ((_bindingsItext) :: [ Doc ] ) -> + case filter ((/= "") . show) _bindingsItext of + [] -> text hole + xs -> foldl1 (<$>) xs + {-# INLINE rule48 #-} + rule48 = \ _text -> + _text +{-# NOINLINE sem_Declaration_PatternBinding #-} +sem_Declaration_PatternBinding :: T_Range -> T_Pattern -> T_RightHandSide -> T_Declaration +sem_Declaration_PatternBinding arg_range_ arg_pattern_ arg_righthandside_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternItext) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_RightHandSide_vOut148 _righthandsideItext) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 ) + _text = rule49 _patternItext _righthandsideItext + _lhsOtext :: Doc + _lhsOtext = rule50 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule49 #-} + rule49 = \ ((_patternItext) :: Doc) ((_righthandsideItext) :: Doc -> Doc ) -> + _patternItext <+> _righthandsideItext (text "=") + {-# INLINE rule50 #-} + rule50 = \ _text -> + _text +{-# NOINLINE sem_Declaration_TypeSignature #-} +sem_Declaration_TypeSignature :: T_Range -> T_Names -> T_Type -> T_Declaration +sem_Declaration_TypeSignature arg_range_ arg_names_ arg_type_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIisIdentifier _namesIisOperator _namesIisSpecial _namesItext) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeItext) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _text = rule51 _namesDocs _typeItext + _namesDocs = rule52 _namesIisOperator _namesItext + _lhsOtext :: Doc + _lhsOtext = rule53 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule51 #-} + rule51 = \ _namesDocs ((_typeItext) :: Doc) -> + commas _namesDocs <+> text "::" <+> _typeItext + {-# INLINE rule52 #-} + rule52 = \ ((_namesIisOperator) :: [Bool] ) ((_namesItext) :: [ Doc ] ) -> + parensIfList _namesIisOperator _namesItext + {-# INLINE rule53 #-} + rule53 = \ _text -> + _text +{-# NOINLINE sem_Declaration_Fixity #-} +sem_Declaration_Fixity :: T_Range -> T_Fixity -> T_MaybeInt -> T_Names -> T_Declaration +sem_Declaration_Fixity arg_range_ arg_fixity_ arg_priority_ arg_operators_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fixityX53 = Control.Monad.Identity.runIdentity (attach_T_Fixity (arg_fixity_)) + _priorityX101 = Control.Monad.Identity.runIdentity (attach_T_MaybeInt (arg_priority_)) + _operatorsX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_operators_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Fixity_vOut52 _fixityItext) = inv_Fixity_s53 _fixityX53 (T_Fixity_vIn52 ) + (T_MaybeInt_vOut100 _priorityItext) = inv_MaybeInt_s101 _priorityX101 (T_MaybeInt_vIn100 ) + (T_Names_vOut115 _operatorsIisIdentifier _operatorsIisOperator _operatorsIisSpecial _operatorsItext) = inv_Names_s116 _operatorsX116 (T_Names_vIn115 ) + _text = rule54 _fixityItext _ops + _ops = rule55 _operatorsIisIdentifier _operatorsItext _priorityItext + _lhsOtext :: Doc + _lhsOtext = rule56 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule54 #-} + rule54 = \ ((_fixityItext) :: Doc) _ops -> + _fixityItext <+> _ops + {-# INLINE rule55 #-} + rule55 = \ ((_operatorsIisIdentifier) :: [Bool] ) ((_operatorsItext) :: [ Doc ] ) ((_priorityItext) :: Maybe Doc ) -> + opt _priorityItext <+> + commas + (map + (\(n, p) -> if p then + text "`" <> n <> text "`" + else + n + ) + (zip _operatorsItext _operatorsIisIdentifier) + ) + {-# INLINE rule56 #-} + rule56 = \ _text -> + _text +{-# NOINLINE sem_Declaration_Empty #-} +sem_Declaration_Empty :: T_Range -> T_Declaration +sem_Declaration_Empty arg_range_ = T_Declaration (return st29) where + {-# NOINLINE st29 #-} + st29 = let + v28 :: T_Declaration_v28 + v28 = \ (T_Declaration_vIn28 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule57 () + _lhsOtext :: Doc + _lhsOtext = rule58 _text + __result_ = T_Declaration_vOut28 _lhsOtext + in __result_ ) + in C_Declaration_s29 v28 + {-# INLINE rule57 #-} + rule57 = \ (_ :: ()) -> + empty + {-# INLINE rule58 #-} + rule58 = \ _text -> + _text + +-- Declarations ------------------------------------------------ +-- wrapper +data Inh_Declarations = Inh_Declarations { } +data Syn_Declarations = Syn_Declarations { text_Syn_Declarations :: ( [ Doc ] ) } +{-# INLINABLE wrap_Declarations #-} +wrap_Declarations :: T_Declarations -> Inh_Declarations -> (Syn_Declarations ) +wrap_Declarations (T_Declarations act) (Inh_Declarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Declarations_vIn31 + (T_Declarations_vOut31 _lhsOtext) <- return (inv_Declarations_s32 sem arg) + return (Syn_Declarations _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Declarations #-} +sem_Declarations :: Declarations -> T_Declarations +sem_Declarations list = Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list) + +-- semantic domain +newtype T_Declarations = T_Declarations { + attach_T_Declarations :: Identity (T_Declarations_s32 ) + } +newtype T_Declarations_s32 = C_Declarations_s32 { + inv_Declarations_s32 :: (T_Declarations_v31 ) + } +data T_Declarations_s33 = C_Declarations_s33 +type T_Declarations_v31 = (T_Declarations_vIn31 ) -> (T_Declarations_vOut31 ) +data T_Declarations_vIn31 = T_Declarations_vIn31 +data T_Declarations_vOut31 = T_Declarations_vOut31 ( [ Doc ] ) +{-# NOINLINE sem_Declarations_Cons #-} +sem_Declarations_Cons :: T_Declaration -> T_Declarations -> T_Declarations +sem_Declarations_Cons arg_hd_ arg_tl_ = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 ) -> ( let + _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Declaration (arg_hd_)) + _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_tl_)) + (T_Declaration_vOut28 _hdItext) = inv_Declaration_s29 _hdX29 (T_Declaration_vIn28 ) + (T_Declarations_vOut31 _tlItext) = inv_Declarations_s32 _tlX32 (T_Declarations_vIn31 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule59 _hdItext _tlItext + __result_ = T_Declarations_vOut31 _lhsOtext + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule59 #-} + rule59 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_Declarations_Nil #-} +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = T_Declarations (return st32) where + {-# NOINLINE st32 #-} + st32 = let + v31 :: T_Declarations_v31 + v31 = \ (T_Declarations_vIn31 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule60 () + __result_ = T_Declarations_vOut31 _lhsOtext + in __result_ ) + in C_Declarations_s32 v31 + {-# INLINE rule60 #-} + rule60 = \ (_ :: ()) -> + [] + +-- Export ------------------------------------------------------ +-- wrapper +data Inh_Export = Inh_Export { } +data Syn_Export = Syn_Export { text_Syn_Export :: (Doc) } +{-# INLINABLE wrap_Export #-} +wrap_Export :: T_Export -> Inh_Export -> (Syn_Export ) +wrap_Export (T_Export act) (Inh_Export ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Export_vIn34 + (T_Export_vOut34 _lhsOtext) <- return (inv_Export_s35 sem arg) + return (Syn_Export _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Export #-} +sem_Export :: Export -> T_Export +sem_Export ( Export_Variable range_ name_ ) = sem_Export_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_TypeOrClass range_ name_ names_ ) = sem_Export_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Export ( Export_TypeOrClassComplete range_ name_ ) = sem_Export_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) +sem_Export ( Export_Module range_ name_ ) = sem_Export_Module ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Export = T_Export { + attach_T_Export :: Identity (T_Export_s35 ) + } +newtype T_Export_s35 = C_Export_s35 { + inv_Export_s35 :: (T_Export_v34 ) + } +data T_Export_s36 = C_Export_s36 +type T_Export_v34 = (T_Export_vIn34 ) -> (T_Export_vOut34 ) +data T_Export_vIn34 = T_Export_vIn34 +data T_Export_vOut34 = T_Export_vOut34 (Doc) +{-# NOINLINE sem_Export_Variable #-} +sem_Export_Variable :: T_Range -> T_Name -> T_Export +sem_Export_Variable arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _text = rule61 _nameItext + _lhsOtext :: Doc + _lhsOtext = rule62 _text + __result_ = T_Export_vOut34 _lhsOtext + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule61 #-} + rule61 = \ ((_nameItext) :: Doc) -> + _nameItext + {-# INLINE rule62 #-} + rule62 = \ _text -> + _text +{-# NOINLINE sem_Export_TypeOrClass #-} +sem_Export_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Export +sem_Export_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesItext) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _text = rule63 _nameItext _namesItext + _lhsOtext :: Doc + _lhsOtext = rule64 _text + __result_ = T_Export_vOut34 _lhsOtext + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule63 #-} + rule63 = \ ((_nameItext) :: Doc) ((_namesItext) :: Maybe [ Doc ] ) -> + _nameItext <> maybe empty tupled (_namesItext) + {-# INLINE rule64 #-} + rule64 = \ _text -> + _text +{-# NOINLINE sem_Export_TypeOrClassComplete #-} +sem_Export_TypeOrClassComplete :: T_Range -> T_Name -> T_Export +sem_Export_TypeOrClassComplete arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _text = rule65 _nameItext + _lhsOtext :: Doc + _lhsOtext = rule66 _text + __result_ = T_Export_vOut34 _lhsOtext + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule65 #-} + rule65 = \ ((_nameItext) :: Doc) -> + _nameItext + {-# INLINE rule66 #-} + rule66 = \ _text -> + _text +{-# NOINLINE sem_Export_Module #-} +sem_Export_Module :: T_Range -> T_Name -> T_Export +sem_Export_Module arg_range_ arg_name_ = T_Export (return st35) where + {-# NOINLINE st35 #-} + st35 = let + v34 :: T_Export_v34 + v34 = \ (T_Export_vIn34 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _text = rule67 _nameItext + _lhsOtext :: Doc + _lhsOtext = rule68 _text + __result_ = T_Export_vOut34 _lhsOtext + in __result_ ) + in C_Export_s35 v34 + {-# INLINE rule67 #-} + rule67 = \ ((_nameItext) :: Doc) -> + text "module" <+> _nameItext + {-# INLINE rule68 #-} + rule68 = \ _text -> + _text + +-- Exports ----------------------------------------------------- +-- wrapper +data Inh_Exports = Inh_Exports { } +data Syn_Exports = Syn_Exports { text_Syn_Exports :: ( [ Doc ] ) } +{-# INLINABLE wrap_Exports #-} +wrap_Exports :: T_Exports -> Inh_Exports -> (Syn_Exports ) +wrap_Exports (T_Exports act) (Inh_Exports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Exports_vIn37 + (T_Exports_vOut37 _lhsOtext) <- return (inv_Exports_s38 sem arg) + return (Syn_Exports _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Exports #-} +sem_Exports :: Exports -> T_Exports +sem_Exports list = Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list) + +-- semantic domain +newtype T_Exports = T_Exports { + attach_T_Exports :: Identity (T_Exports_s38 ) + } +newtype T_Exports_s38 = C_Exports_s38 { + inv_Exports_s38 :: (T_Exports_v37 ) + } +data T_Exports_s39 = C_Exports_s39 +type T_Exports_v37 = (T_Exports_vIn37 ) -> (T_Exports_vOut37 ) +data T_Exports_vIn37 = T_Exports_vIn37 +data T_Exports_vOut37 = T_Exports_vOut37 ( [ Doc ] ) +{-# NOINLINE sem_Exports_Cons #-} +sem_Exports_Cons :: T_Export -> T_Exports -> T_Exports +sem_Exports_Cons arg_hd_ arg_tl_ = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Export (arg_hd_)) + _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_tl_)) + (T_Export_vOut34 _hdItext) = inv_Export_s35 _hdX35 (T_Export_vIn34 ) + (T_Exports_vOut37 _tlItext) = inv_Exports_s38 _tlX38 (T_Exports_vIn37 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule69 _hdItext _tlItext + __result_ = T_Exports_vOut37 _lhsOtext + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule69 #-} + rule69 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_Exports_Nil #-} +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = T_Exports (return st38) where + {-# NOINLINE st38 #-} + st38 = let + v37 :: T_Exports_v37 + v37 = \ (T_Exports_vIn37 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule70 () + __result_ = T_Exports_vOut37 _lhsOtext + in __result_ ) + in C_Exports_s38 v37 + {-# INLINE rule70 #-} + rule70 = \ (_ :: ()) -> + [] + +-- Expression -------------------------------------------------- +-- wrapper +data Inh_Expression = Inh_Expression { } +data Syn_Expression = Syn_Expression { text_Syn_Expression :: (Doc) } +{-# INLINABLE wrap_Expression #-} +wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) +wrap_Expression (T_Expression act) (Inh_Expression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expression_vIn40 + (T_Expression_vOut40 _lhsOtext) <- return (inv_Expression_s41 sem arg) + return (Syn_Expression _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Expression #-} +sem_Expression :: Expression -> T_Expression +sem_Expression ( Expression_Hole range_ id_ ) = sem_Expression_Hole ( sem_Range range_ ) id_ +sem_Expression ( Expression_Feedback range_ feedback_ expression_ ) = sem_Expression_Feedback ( sem_Range range_ ) feedback_ ( sem_Expression expression_ ) +sem_Expression ( Expression_MustUse range_ expression_ ) = sem_Expression_MustUse ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Literal range_ literal_ ) = sem_Expression_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Expression ( Expression_Variable range_ name_ ) = sem_Expression_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Constructor range_ name_ ) = sem_Expression_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Expression ( Expression_Parenthesized range_ expression_ ) = sem_Expression_Parenthesized ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NormalApplication range_ function_ arguments_ ) = sem_Expression_NormalApplication ( sem_Range range_ ) ( sem_Expression function_ ) ( sem_Expressions arguments_ ) +sem_Expression ( Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ ) = sem_Expression_InfixApplication ( sem_Range range_ ) ( sem_MaybeExpression leftExpression_ ) ( sem_Expression operator_ ) ( sem_MaybeExpression rightExpression_ ) +sem_Expression ( Expression_If range_ guardExpression_ thenExpression_ elseExpression_ ) = sem_Expression_If ( sem_Range range_ ) ( sem_Expression guardExpression_ ) ( sem_Expression thenExpression_ ) ( sem_Expression elseExpression_ ) +sem_Expression ( Expression_Lambda range_ patterns_ expression_ ) = sem_Expression_Lambda ( sem_Range range_ ) ( sem_Patterns patterns_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Case range_ expression_ alternatives_ ) = sem_Expression_Case ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Alternatives alternatives_ ) +sem_Expression ( Expression_Let range_ declarations_ expression_ ) = sem_Expression_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_Do range_ statements_ ) = sem_Expression_Do ( sem_Range range_ ) ( sem_Statements statements_ ) +sem_Expression ( Expression_List range_ expressions_ ) = sem_Expression_List ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Tuple range_ expressions_ ) = sem_Expression_Tuple ( sem_Range range_ ) ( sem_Expressions expressions_ ) +sem_Expression ( Expression_Comprehension range_ expression_ qualifiers_ ) = sem_Expression_Comprehension ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Qualifiers qualifiers_ ) +sem_Expression ( Expression_Typed range_ expression_ type_ ) = sem_Expression_Typed ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_Type type_ ) +sem_Expression ( Expression_RecordConstruction range_ name_ recordExpressionBindings_ ) = sem_Expression_RecordConstruction ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_RecordUpdate range_ expression_ recordExpressionBindings_ ) = sem_Expression_RecordUpdate ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_RecordExpressionBindings recordExpressionBindings_ ) +sem_Expression ( Expression_Enum range_ from_ then_ to_ ) = sem_Expression_Enum ( sem_Range range_ ) ( sem_Expression from_ ) ( sem_MaybeExpression then_ ) ( sem_MaybeExpression to_ ) +sem_Expression ( Expression_Negate range_ expression_ ) = sem_Expression_Negate ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Expression ( Expression_NegateFloat range_ expression_ ) = sem_Expression_NegateFloat ( sem_Range range_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_Expression = T_Expression { + attach_T_Expression :: Identity (T_Expression_s41 ) + } +newtype T_Expression_s41 = C_Expression_s41 { + inv_Expression_s41 :: (T_Expression_v40 ) + } +data T_Expression_s42 = C_Expression_s42 +type T_Expression_v40 = (T_Expression_vIn40 ) -> (T_Expression_vOut40 ) +data T_Expression_vIn40 = T_Expression_vIn40 +data T_Expression_vOut40 = T_Expression_vOut40 (Doc) +{-# NOINLINE sem_Expression_Hole #-} +sem_Expression_Hole :: T_Range -> (Integer) -> T_Expression +sem_Expression_Hole arg_range_ _ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule71 () + _lhsOtext :: Doc + _lhsOtext = rule72 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule71 #-} + rule71 = \ (_ :: ()) -> + text hole + {-# INLINE rule72 #-} + rule72 = \ _text -> + _text +{-# NOINLINE sem_Expression_Feedback #-} +sem_Expression_Feedback :: T_Range -> (String) -> T_Expression -> T_Expression +sem_Expression_Feedback arg_range_ _ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _lhsOtext :: Doc + _lhsOtext = rule73 _expressionItext + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule73 #-} + rule73 = \ ((_expressionItext) :: Doc) -> + _expressionItext +{-# NOINLINE sem_Expression_MustUse #-} +sem_Expression_MustUse :: T_Range -> T_Expression -> T_Expression +sem_Expression_MustUse arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _lhsOtext :: Doc + _lhsOtext = rule74 _expressionItext + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule74 #-} + rule74 = \ ((_expressionItext) :: Doc) -> + _expressionItext +{-# NOINLINE sem_Expression_Literal #-} +sem_Expression_Literal :: T_Range -> T_Literal -> T_Expression +sem_Expression_Literal arg_range_ arg_literal_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalItext) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _text = rule75 _literalItext + _lhsOtext :: Doc + _lhsOtext = rule76 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule75 #-} + rule75 = \ ((_literalItext) :: Doc) -> + _literalItext + {-# INLINE rule76 #-} + rule76 = \ _text -> + _text +{-# NOINLINE sem_Expression_Variable #-} +sem_Expression_Variable :: T_Range -> T_Name -> T_Expression +sem_Expression_Variable arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _text = rule77 _nameItext + _lhsOtext :: Doc + _lhsOtext = rule78 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule77 #-} + rule77 = \ ((_nameItext) :: Doc) -> + _nameItext + {-# INLINE rule78 #-} + rule78 = \ _text -> + _text +{-# NOINLINE sem_Expression_Constructor #-} +sem_Expression_Constructor :: T_Range -> T_Name -> T_Expression +sem_Expression_Constructor arg_range_ arg_name_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _text = rule79 _nameItext + _lhsOtext :: Doc + _lhsOtext = rule80 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule79 #-} + rule79 = \ ((_nameItext) :: Doc) -> + _nameItext + {-# INLINE rule80 #-} + rule80 = \ _text -> + _text +{-# NOINLINE sem_Expression_Parenthesized #-} +sem_Expression_Parenthesized :: T_Range -> T_Expression -> T_Expression +sem_Expression_Parenthesized arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _text = rule81 _expressionItext + _lhsOtext :: Doc + _lhsOtext = rule82 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule81 #-} + rule81 = \ ((_expressionItext) :: Doc) -> + parens _expressionItext + {-# INLINE rule82 #-} + rule82 = \ _text -> + _text +{-# NOINLINE sem_Expression_NormalApplication #-} +sem_Expression_NormalApplication :: T_Range -> T_Expression -> T_Expressions -> T_Expression +sem_Expression_NormalApplication arg_range_ arg_function_ arg_arguments_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_function_)) + _argumentsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_arguments_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _functionItext) = inv_Expression_s41 _functionX41 (T_Expression_vIn40 ) + (T_Expressions_vOut43 _argumentsItext) = inv_Expressions_s44 _argumentsX44 (T_Expressions_vIn43 ) + _text = rule83 _argumentsItext _functionItext + _lhsOtext :: Doc + _lhsOtext = rule84 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule83 #-} + rule83 = \ ((_argumentsItext) :: [ Doc ] ) ((_functionItext) :: Doc) -> + foldl (<+>) _functionItext _argumentsItext + {-# INLINE rule84 #-} + rule84 = \ _text -> + _text +{-# NOINLINE sem_Expression_InfixApplication #-} +sem_Expression_InfixApplication :: T_Range -> T_MaybeExpression -> T_Expression -> T_MaybeExpression -> T_Expression +sem_Expression_InfixApplication arg_range_ arg_leftExpression_ arg_operator_ arg_rightExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_leftExpression_)) + _operatorX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_operator_)) + _rightExpressionX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_rightExpression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeExpression_vOut94 _leftExpressionItext) = inv_MaybeExpression_s95 _leftExpressionX95 (T_MaybeExpression_vIn94 ) + (T_Expression_vOut40 _operatorItext) = inv_Expression_s41 _operatorX41 (T_Expression_vIn40 ) + (T_MaybeExpression_vOut94 _rightExpressionItext) = inv_MaybeExpression_s95 _rightExpressionX95 (T_MaybeExpression_vIn94 ) + _text = rule85 _leftExpressionItext _operatorItext _rightExpressionItext + _lhsOtext :: Doc + _lhsOtext = rule86 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule85 #-} + rule85 = \ ((_leftExpressionItext) :: Maybe Doc ) ((_operatorItext) :: Doc) ((_rightExpressionItext) :: Maybe Doc ) -> + let f [] m = m + f (c:cs) m = if isAlpha c && all (\ch -> ch == '_' || ch == '\'' || isAlphaNum ch) cs then char '`' <> m <> char '`' else m + in + case (_leftExpressionItext, _rightExpressionItext) of + (Nothing, Nothing) -> + parens _operatorItext + (Just l , Nothing) -> + parens (l <+> _operatorItext) + (Nothing, Just r ) -> + parens (_operatorItext <+> r) + (Just l , Just r ) -> + l + <+> + f (show _operatorItext) _operatorItext + <+> + r + {-# INLINE rule86 #-} + rule86 = \ _text -> + _text +{-# NOINLINE sem_Expression_If #-} +sem_Expression_If :: T_Range -> T_Expression -> T_Expression -> T_Expression -> T_Expression +sem_Expression_If arg_range_ arg_guardExpression_ arg_thenExpression_ arg_elseExpression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guardExpression_)) + _thenExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_thenExpression_)) + _elseExpressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_elseExpression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardExpressionItext) = inv_Expression_s41 _guardExpressionX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _thenExpressionItext) = inv_Expression_s41 _thenExpressionX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _elseExpressionItext) = inv_Expression_s41 _elseExpressionX41 (T_Expression_vIn40 ) + _text = rule87 _elseExpressionItext _guardExpressionItext _thenExpressionItext + _lhsOtext :: Doc + _lhsOtext = rule88 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule87 #-} + rule87 = \ ((_elseExpressionItext) :: Doc) ((_guardExpressionItext) :: Doc) ((_thenExpressionItext) :: Doc) -> + text "if" <+> _guardExpressionItext <$> + indent 4 (text "then" <+> _thenExpressionItext <$> + text "else" <+> _elseExpressionItext) + {-# INLINE rule88 #-} + rule88 = \ _text -> + _text +{-# NOINLINE sem_Expression_Lambda #-} +sem_Expression_Lambda :: T_Range -> T_Patterns -> T_Expression -> T_Expression +sem_Expression_Lambda arg_range_ arg_patterns_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsItext) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _text = rule89 _expressionItext _patternsItext + _lhsOtext :: Doc + _lhsOtext = rule90 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule89 #-} + rule89 = \ ((_expressionItext) :: Doc) ((_patternsItext) :: [ Doc ] ) -> + text "\\" <+> foldl1 (<+>) _patternsItext <+> text "->" <+> _expressionItext + {-# INLINE rule90 #-} + rule90 = \ _text -> + _text +{-# NOINLINE sem_Expression_Case #-} +sem_Expression_Case :: T_Range -> T_Expression -> T_Alternatives -> T_Expression +sem_Expression_Case arg_range_ arg_expression_ arg_alternatives_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _alternativesX5 = Control.Monad.Identity.runIdentity (attach_T_Alternatives (arg_alternatives_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Alternatives_vOut4 _alternativesItext) = inv_Alternatives_s5 _alternativesX5 (T_Alternatives_vIn4 ) + _text = rule91 _alternativesItext _expressionItext + _lhsOtext :: Doc + _lhsOtext = rule92 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule91 #-} + rule91 = \ ((_alternativesItext) :: [ Doc ] ) ((_expressionItext) :: Doc) -> + (text "case" <+> _expressionItext <+> text "of" <$> + (indent 4 $ vcat _alternativesItext) <$> empty + ) + {-# INLINE rule92 #-} + rule92 = \ _text -> + _text +{-# NOINLINE sem_Expression_Let #-} +sem_Expression_Let :: T_Range -> T_Declarations -> T_Expression -> T_Expression +sem_Expression_Let arg_range_ arg_declarations_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsItext) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _text = rule93 _declarationsItext _expressionItext + _lhsOtext :: Doc + _lhsOtext = rule94 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule93 #-} + rule93 = \ ((_declarationsItext) :: [ Doc ] ) ((_expressionItext) :: Doc) -> + (text "let"<$> + (indent 4 $ vcat _declarationsItext) <+> + text "in" <$> + (indent 4 $ _expressionItext) + ) <$> empty + {-# INLINE rule94 #-} + rule94 = \ _text -> + _text +{-# NOINLINE sem_Expression_Do #-} +sem_Expression_Do :: T_Range -> T_Statements -> T_Expression +sem_Expression_Do arg_range_ arg_statements_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _statementsX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_statements_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Statements_vOut157 _statementsItext) = inv_Statements_s158 _statementsX158 (T_Statements_vIn157 ) + _text = rule95 _statementsItext + _lhsOtext :: Doc + _lhsOtext = rule96 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule95 #-} + rule95 = \ ((_statementsItext) :: [ Doc ] ) -> + text "do" <$> (indent 4 $ vcat _statementsItext) <$> empty + {-# INLINE rule96 #-} + rule96 = \ _text -> + _text +{-# NOINLINE sem_Expression_List #-} +sem_Expression_List :: T_Range -> T_Expressions -> T_Expression +sem_Expression_List arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsItext) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 ) + _text = rule97 _expressionsItext + _lhsOtext :: Doc + _lhsOtext = rule98 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule97 #-} + rule97 = \ ((_expressionsItext) :: [ Doc ] ) -> + PPrint.list _expressionsItext + {-# INLINE rule98 #-} + rule98 = \ _text -> + _text +{-# NOINLINE sem_Expression_Tuple #-} +sem_Expression_Tuple :: T_Range -> T_Expressions -> T_Expression +sem_Expression_Tuple arg_range_ arg_expressions_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionsX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_expressions_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expressions_vOut43 _expressionsItext) = inv_Expressions_s44 _expressionsX44 (T_Expressions_vIn43 ) + _text = rule99 _expressionsItext + _lhsOtext :: Doc + _lhsOtext = rule100 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule99 #-} + rule99 = \ ((_expressionsItext) :: [ Doc ] ) -> + tupled _expressionsItext + {-# INLINE rule100 #-} + rule100 = \ _text -> + _text +{-# NOINLINE sem_Expression_Comprehension #-} +sem_Expression_Comprehension :: T_Range -> T_Expression -> T_Qualifiers -> T_Expression +sem_Expression_Comprehension arg_range_ arg_expression_ arg_qualifiers_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _qualifiersX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_qualifiers_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Qualifiers_vOut130 _qualifiersItext) = inv_Qualifiers_s131 _qualifiersX131 (T_Qualifiers_vIn130 ) + _text = rule101 _expressionItext _qualifiersItext + _lhsOtext :: Doc + _lhsOtext = rule102 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule101 #-} + rule101 = \ ((_expressionItext) :: Doc) ((_qualifiersItext) :: [ Doc ] ) -> + text "[" <+> _expressionItext <+> + text "|" <+> commas _qualifiersItext <+> text "]" + {-# INLINE rule102 #-} + rule102 = \ _text -> + _text +{-# NOINLINE sem_Expression_Typed #-} +sem_Expression_Typed :: T_Range -> T_Expression -> T_Type -> T_Expression +sem_Expression_Typed arg_range_ arg_expression_ arg_type_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_Type_vOut163 _typeItext) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _text = rule103 _expressionItext _typeItext + _lhsOtext :: Doc + _lhsOtext = rule104 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule103 #-} + rule103 = \ ((_expressionItext) :: Doc) ((_typeItext) :: Doc) -> + _expressionItext <+> text "::" <+> _typeItext + {-# INLINE rule104 #-} + rule104 = \ _text -> + _text +{-# NOINLINE sem_Expression_RecordConstruction #-} +sem_Expression_RecordConstruction :: T_Range -> T_Name -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordConstruction arg_range_ arg_name_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsItext) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 ) + _text = rule105 () + _lhsOtext :: Doc + _lhsOtext = rule106 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule105 #-} + rule105 = \ (_ :: ()) -> + intErr "Expression" "record construction" + {-# INLINE rule106 #-} + rule106 = \ _text -> + _text +{-# NOINLINE sem_Expression_RecordUpdate #-} +sem_Expression_RecordUpdate :: T_Range -> T_Expression -> T_RecordExpressionBindings -> T_Expression +sem_Expression_RecordUpdate arg_range_ arg_expression_ arg_recordExpressionBindings_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _recordExpressionBindingsX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_recordExpressionBindings_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_RecordExpressionBindings_vOut139 _recordExpressionBindingsItext) = inv_RecordExpressionBindings_s140 _recordExpressionBindingsX140 (T_RecordExpressionBindings_vIn139 ) + _text = rule107 () + _lhsOtext :: Doc + _lhsOtext = rule108 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule107 #-} + rule107 = \ (_ :: ()) -> + intErr "Expression" "record update" + {-# INLINE rule108 #-} + rule108 = \ _text -> + _text +{-# NOINLINE sem_Expression_Enum #-} +sem_Expression_Enum :: T_Range -> T_Expression -> T_MaybeExpression -> T_MaybeExpression -> T_Expression +sem_Expression_Enum arg_range_ arg_from_ arg_then_ arg_to_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _fromX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_from_)) + _thenX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_then_)) + _toX95 = Control.Monad.Identity.runIdentity (attach_T_MaybeExpression (arg_to_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _fromItext) = inv_Expression_s41 _fromX41 (T_Expression_vIn40 ) + (T_MaybeExpression_vOut94 _thenItext) = inv_MaybeExpression_s95 _thenX95 (T_MaybeExpression_vIn94 ) + (T_MaybeExpression_vOut94 _toItext) = inv_MaybeExpression_s95 _toX95 (T_MaybeExpression_vIn94 ) + _text = rule109 _fromItext _thenItext _toItext + _lhsOtext :: Doc + _lhsOtext = rule110 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule109 #-} + rule109 = \ ((_fromItext) :: Doc) ((_thenItext) :: Maybe Doc ) ((_toItext) :: Maybe Doc ) -> + text "[" <> + _fromItext <> + maybe empty (text "," <+>) _thenItext <+> + text ".." <+> + opt _toItext <> + text "]" + {-# INLINE rule110 #-} + rule110 = \ _text -> + _text +{-# NOINLINE sem_Expression_Negate #-} +sem_Expression_Negate :: T_Range -> T_Expression -> T_Expression +sem_Expression_Negate arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _text = rule111 _expressionItext + _lhsOtext :: Doc + _lhsOtext = rule112 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule111 #-} + rule111 = \ ((_expressionItext) :: Doc) -> + text "-" <> _expressionItext + {-# INLINE rule112 #-} + rule112 = \ _text -> + _text +{-# NOINLINE sem_Expression_NegateFloat #-} +sem_Expression_NegateFloat :: T_Range -> T_Expression -> T_Expression +sem_Expression_NegateFloat arg_range_ arg_expression_ = T_Expression (return st41) where + {-# NOINLINE st41 #-} + st41 = let + v40 :: T_Expression_v40 + v40 = \ (T_Expression_vIn40 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _text = rule113 _expressionItext + _lhsOtext :: Doc + _lhsOtext = rule114 _text + __result_ = T_Expression_vOut40 _lhsOtext + in __result_ ) + in C_Expression_s41 v40 + {-# INLINE rule113 #-} + rule113 = \ ((_expressionItext) :: Doc) -> + text "-." <> _expressionItext + {-# INLINE rule114 #-} + rule114 = \ _text -> + _text + +-- Expressions ------------------------------------------------- +-- wrapper +data Inh_Expressions = Inh_Expressions { } +data Syn_Expressions = Syn_Expressions { text_Syn_Expressions :: ( [ Doc ] ) } +{-# INLINABLE wrap_Expressions #-} +wrap_Expressions :: T_Expressions -> Inh_Expressions -> (Syn_Expressions ) +wrap_Expressions (T_Expressions act) (Inh_Expressions ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Expressions_vIn43 + (T_Expressions_vOut43 _lhsOtext) <- return (inv_Expressions_s44 sem arg) + return (Syn_Expressions _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Expressions #-} +sem_Expressions :: Expressions -> T_Expressions +sem_Expressions list = Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list) + +-- semantic domain +newtype T_Expressions = T_Expressions { + attach_T_Expressions :: Identity (T_Expressions_s44 ) + } +newtype T_Expressions_s44 = C_Expressions_s44 { + inv_Expressions_s44 :: (T_Expressions_v43 ) + } +data T_Expressions_s45 = C_Expressions_s45 +type T_Expressions_v43 = (T_Expressions_vIn43 ) -> (T_Expressions_vOut43 ) +data T_Expressions_vIn43 = T_Expressions_vIn43 +data T_Expressions_vOut43 = T_Expressions_vOut43 ( [ Doc ] ) +{-# NOINLINE sem_Expressions_Cons #-} +sem_Expressions_Cons :: T_Expression -> T_Expressions -> T_Expressions +sem_Expressions_Cons arg_hd_ arg_tl_ = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 ) -> ( let + _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_hd_)) + _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Expressions (arg_tl_)) + (T_Expression_vOut40 _hdItext) = inv_Expression_s41 _hdX41 (T_Expression_vIn40 ) + (T_Expressions_vOut43 _tlItext) = inv_Expressions_s44 _tlX44 (T_Expressions_vIn43 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule115 _hdItext _tlItext + __result_ = T_Expressions_vOut43 _lhsOtext + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule115 #-} + rule115 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_Expressions_Nil #-} +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = T_Expressions (return st44) where + {-# NOINLINE st44 #-} + st44 = let + v43 :: T_Expressions_v43 + v43 = \ (T_Expressions_vIn43 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule116 () + __result_ = T_Expressions_vOut43 _lhsOtext + in __result_ ) + in C_Expressions_s44 v43 + {-# INLINE rule116 #-} + rule116 = \ (_ :: ()) -> + [] + +-- FieldDeclaration -------------------------------------------- +-- wrapper +data Inh_FieldDeclaration = Inh_FieldDeclaration { } +data Syn_FieldDeclaration = Syn_FieldDeclaration { text_Syn_FieldDeclaration :: (Doc) } +{-# INLINABLE wrap_FieldDeclaration #-} +wrap_FieldDeclaration :: T_FieldDeclaration -> Inh_FieldDeclaration -> (Syn_FieldDeclaration ) +wrap_FieldDeclaration (T_FieldDeclaration act) (Inh_FieldDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclaration_vIn46 + (T_FieldDeclaration_vOut46 _lhsOtext) <- return (inv_FieldDeclaration_s47 sem arg) + return (Syn_FieldDeclaration _lhsOtext) + ) + +-- cata +{-# INLINE sem_FieldDeclaration #-} +sem_FieldDeclaration :: FieldDeclaration -> T_FieldDeclaration +sem_FieldDeclaration ( FieldDeclaration_FieldDeclaration range_ names_ type_ ) = sem_FieldDeclaration_FieldDeclaration ( sem_Range range_ ) ( sem_Names names_ ) ( sem_AnnotatedType type_ ) + +-- semantic domain +newtype T_FieldDeclaration = T_FieldDeclaration { + attach_T_FieldDeclaration :: Identity (T_FieldDeclaration_s47 ) + } +newtype T_FieldDeclaration_s47 = C_FieldDeclaration_s47 { + inv_FieldDeclaration_s47 :: (T_FieldDeclaration_v46 ) + } +data T_FieldDeclaration_s48 = C_FieldDeclaration_s48 +type T_FieldDeclaration_v46 = (T_FieldDeclaration_vIn46 ) -> (T_FieldDeclaration_vOut46 ) +data T_FieldDeclaration_vIn46 = T_FieldDeclaration_vIn46 +data T_FieldDeclaration_vOut46 = T_FieldDeclaration_vOut46 (Doc) +{-# NOINLINE sem_FieldDeclaration_FieldDeclaration #-} +sem_FieldDeclaration_FieldDeclaration :: T_Range -> T_Names -> T_AnnotatedType -> T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration arg_range_ arg_names_ arg_type_ = T_FieldDeclaration (return st47) where + {-# NOINLINE st47 #-} + st47 = let + v46 :: T_FieldDeclaration_v46 + v46 = \ (T_FieldDeclaration_vIn46 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + _typeX8 = Control.Monad.Identity.runIdentity (attach_T_AnnotatedType (arg_type_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _namesIisIdentifier _namesIisOperator _namesIisSpecial _namesItext) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + (T_AnnotatedType_vOut7 _typeItext) = inv_AnnotatedType_s8 _typeX8 (T_AnnotatedType_vIn7 ) + _text = rule117 () + _lhsOtext :: Doc + _lhsOtext = rule118 _text + __result_ = T_FieldDeclaration_vOut46 _lhsOtext + in __result_ ) + in C_FieldDeclaration_s47 v46 + {-# INLINE rule117 #-} + rule117 = \ (_ :: ()) -> + text "{- !!! field declaration -}" + {-# INLINE rule118 #-} + rule118 = \ _text -> + _text + +-- FieldDeclarations ------------------------------------------- +-- wrapper +data Inh_FieldDeclarations = Inh_FieldDeclarations { } +data Syn_FieldDeclarations = Syn_FieldDeclarations { text_Syn_FieldDeclarations :: ( [ Doc ] ) } +{-# INLINABLE wrap_FieldDeclarations #-} +wrap_FieldDeclarations :: T_FieldDeclarations -> Inh_FieldDeclarations -> (Syn_FieldDeclarations ) +wrap_FieldDeclarations (T_FieldDeclarations act) (Inh_FieldDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FieldDeclarations_vIn49 + (T_FieldDeclarations_vOut49 _lhsOtext) <- return (inv_FieldDeclarations_s50 sem arg) + return (Syn_FieldDeclarations _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_FieldDeclarations #-} +sem_FieldDeclarations :: FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations list = Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list) + +-- semantic domain +newtype T_FieldDeclarations = T_FieldDeclarations { + attach_T_FieldDeclarations :: Identity (T_FieldDeclarations_s50 ) + } +newtype T_FieldDeclarations_s50 = C_FieldDeclarations_s50 { + inv_FieldDeclarations_s50 :: (T_FieldDeclarations_v49 ) + } +data T_FieldDeclarations_s51 = C_FieldDeclarations_s51 +type T_FieldDeclarations_v49 = (T_FieldDeclarations_vIn49 ) -> (T_FieldDeclarations_vOut49 ) +data T_FieldDeclarations_vIn49 = T_FieldDeclarations_vIn49 +data T_FieldDeclarations_vOut49 = T_FieldDeclarations_vOut49 ( [ Doc ] ) +{-# NOINLINE sem_FieldDeclarations_Cons #-} +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> T_FieldDeclarations -> T_FieldDeclarations +sem_FieldDeclarations_Cons arg_hd_ arg_tl_ = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _hdX47 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclaration (arg_hd_)) + _tlX50 = Control.Monad.Identity.runIdentity (attach_T_FieldDeclarations (arg_tl_)) + (T_FieldDeclaration_vOut46 _hdItext) = inv_FieldDeclaration_s47 _hdX47 (T_FieldDeclaration_vIn46 ) + (T_FieldDeclarations_vOut49 _tlItext) = inv_FieldDeclarations_s50 _tlX50 (T_FieldDeclarations_vIn49 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule119 _hdItext _tlItext + __result_ = T_FieldDeclarations_vOut49 _lhsOtext + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule119 #-} + rule119 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_FieldDeclarations_Nil #-} +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = T_FieldDeclarations (return st50) where + {-# NOINLINE st50 #-} + st50 = let + v49 :: T_FieldDeclarations_v49 + v49 = \ (T_FieldDeclarations_vIn49 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule120 () + __result_ = T_FieldDeclarations_vOut49 _lhsOtext + in __result_ ) + in C_FieldDeclarations_s50 v49 + {-# INLINE rule120 #-} + rule120 = \ (_ :: ()) -> + [] + +-- Fixity ------------------------------------------------------ +-- wrapper +data Inh_Fixity = Inh_Fixity { } +data Syn_Fixity = Syn_Fixity { text_Syn_Fixity :: (Doc) } +{-# INLINABLE wrap_Fixity #-} +wrap_Fixity :: T_Fixity -> Inh_Fixity -> (Syn_Fixity ) +wrap_Fixity (T_Fixity act) (Inh_Fixity ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Fixity_vIn52 + (T_Fixity_vOut52 _lhsOtext) <- return (inv_Fixity_s53 sem arg) + return (Syn_Fixity _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Fixity #-} +sem_Fixity :: Fixity -> T_Fixity +sem_Fixity ( Fixity_Infixl range_ ) = sem_Fixity_Infixl ( sem_Range range_ ) +sem_Fixity ( Fixity_Infixr range_ ) = sem_Fixity_Infixr ( sem_Range range_ ) +sem_Fixity ( Fixity_Infix range_ ) = sem_Fixity_Infix ( sem_Range range_ ) + +-- semantic domain +newtype T_Fixity = T_Fixity { + attach_T_Fixity :: Identity (T_Fixity_s53 ) + } +newtype T_Fixity_s53 = C_Fixity_s53 { + inv_Fixity_s53 :: (T_Fixity_v52 ) + } +data T_Fixity_s54 = C_Fixity_s54 +type T_Fixity_v52 = (T_Fixity_vIn52 ) -> (T_Fixity_vOut52 ) +data T_Fixity_vIn52 = T_Fixity_vIn52 +data T_Fixity_vOut52 = T_Fixity_vOut52 (Doc) +{-# NOINLINE sem_Fixity_Infixl #-} +sem_Fixity_Infixl :: T_Range -> T_Fixity +sem_Fixity_Infixl arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule121 () + _lhsOtext :: Doc + _lhsOtext = rule122 _text + __result_ = T_Fixity_vOut52 _lhsOtext + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule121 #-} + rule121 = \ (_ :: ()) -> + text "infixl" + {-# INLINE rule122 #-} + rule122 = \ _text -> + _text +{-# NOINLINE sem_Fixity_Infixr #-} +sem_Fixity_Infixr :: T_Range -> T_Fixity +sem_Fixity_Infixr arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule123 () + _lhsOtext :: Doc + _lhsOtext = rule124 _text + __result_ = T_Fixity_vOut52 _lhsOtext + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule123 #-} + rule123 = \ (_ :: ()) -> + text "infixr" + {-# INLINE rule124 #-} + rule124 = \ _text -> + _text +{-# NOINLINE sem_Fixity_Infix #-} +sem_Fixity_Infix :: T_Range -> T_Fixity +sem_Fixity_Infix arg_range_ = T_Fixity (return st53) where + {-# NOINLINE st53 #-} + st53 = let + v52 :: T_Fixity_v52 + v52 = \ (T_Fixity_vIn52 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule125 () + _lhsOtext :: Doc + _lhsOtext = rule126 _text + __result_ = T_Fixity_vOut52 _lhsOtext + in __result_ ) + in C_Fixity_s53 v52 + {-# INLINE rule125 #-} + rule125 = \ (_ :: ()) -> + text "infix " + {-# INLINE rule126 #-} + rule126 = \ _text -> + _text + +-- FunctionBinding --------------------------------------------- +-- wrapper +data Inh_FunctionBinding = Inh_FunctionBinding { } +data Syn_FunctionBinding = Syn_FunctionBinding { text_Syn_FunctionBinding :: (Doc) } +{-# INLINABLE wrap_FunctionBinding #-} +wrap_FunctionBinding :: T_FunctionBinding -> Inh_FunctionBinding -> (Syn_FunctionBinding ) +wrap_FunctionBinding (T_FunctionBinding act) (Inh_FunctionBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBinding_vIn55 + (T_FunctionBinding_vOut55 _lhsOtext) <- return (inv_FunctionBinding_s56 sem arg) + return (Syn_FunctionBinding _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_FunctionBinding #-} +sem_FunctionBinding :: FunctionBinding -> T_FunctionBinding +sem_FunctionBinding ( FunctionBinding_Hole range_ id_ ) = sem_FunctionBinding_Hole ( sem_Range range_ ) id_ +sem_FunctionBinding ( FunctionBinding_Feedback range_ feedback_ functionBinding_ ) = sem_FunctionBinding_Feedback ( sem_Range range_ ) feedback_ ( sem_FunctionBinding functionBinding_ ) +sem_FunctionBinding ( FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ ) = sem_FunctionBinding_FunctionBinding ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_RightHandSide righthandside_ ) + +-- semantic domain +newtype T_FunctionBinding = T_FunctionBinding { + attach_T_FunctionBinding :: Identity (T_FunctionBinding_s56 ) + } +newtype T_FunctionBinding_s56 = C_FunctionBinding_s56 { + inv_FunctionBinding_s56 :: (T_FunctionBinding_v55 ) + } +data T_FunctionBinding_s57 = C_FunctionBinding_s57 +type T_FunctionBinding_v55 = (T_FunctionBinding_vIn55 ) -> (T_FunctionBinding_vOut55 ) +data T_FunctionBinding_vIn55 = T_FunctionBinding_vIn55 +data T_FunctionBinding_vOut55 = T_FunctionBinding_vOut55 (Doc) +{-# NOINLINE sem_FunctionBinding_Hole #-} +sem_FunctionBinding_Hole :: T_Range -> (Integer) -> T_FunctionBinding +sem_FunctionBinding_Hole arg_range_ _ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule127 () + _lhsOtext :: Doc + _lhsOtext = rule128 _text + __result_ = T_FunctionBinding_vOut55 _lhsOtext + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule127 #-} + rule127 = \ (_ :: ()) -> + empty + {-# INLINE rule128 #-} + rule128 = \ _text -> + _text +{-# NOINLINE sem_FunctionBinding_Feedback #-} +sem_FunctionBinding_Feedback :: T_Range -> (String) -> T_FunctionBinding -> T_FunctionBinding +sem_FunctionBinding_Feedback arg_range_ _ arg_functionBinding_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionBindingX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_functionBinding_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_FunctionBinding_vOut55 _functionBindingItext) = inv_FunctionBinding_s56 _functionBindingX56 (T_FunctionBinding_vIn55 ) + _lhsOtext :: Doc + _lhsOtext = rule129 _functionBindingItext + __result_ = T_FunctionBinding_vOut55 _lhsOtext + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule129 #-} + rule129 = \ ((_functionBindingItext) :: Doc) -> + _functionBindingItext +{-# NOINLINE sem_FunctionBinding_FunctionBinding #-} +sem_FunctionBinding_FunctionBinding :: T_Range -> T_LeftHandSide -> T_RightHandSide -> T_FunctionBinding +sem_FunctionBinding_FunctionBinding arg_range_ arg_lefthandside_ arg_righthandside_ = T_FunctionBinding (return st56) where + {-# NOINLINE st56 #-} + st56 = let + v55 :: T_FunctionBinding_v55 + v55 = \ (T_FunctionBinding_vIn55 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _righthandsideX149 = Control.Monad.Identity.runIdentity (attach_T_RightHandSide (arg_righthandside_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideItext) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 ) + (T_RightHandSide_vOut148 _righthandsideItext) = inv_RightHandSide_s149 _righthandsideX149 (T_RightHandSide_vIn148 ) + _text = rule130 _lefthandsideItext _righthandsideItext + _lhsOtext :: Doc + _lhsOtext = rule131 _text + __result_ = T_FunctionBinding_vOut55 _lhsOtext + in __result_ ) + in C_FunctionBinding_s56 v55 + {-# INLINE rule130 #-} + rule130 = \ ((_lefthandsideItext) :: Doc) ((_righthandsideItext) :: Doc -> Doc ) -> + _lefthandsideItext <+> _righthandsideItext (text "=") + {-# INLINE rule131 #-} + rule131 = \ _text -> + _text + +-- FunctionBindings -------------------------------------------- +-- wrapper +data Inh_FunctionBindings = Inh_FunctionBindings { } +data Syn_FunctionBindings = Syn_FunctionBindings { text_Syn_FunctionBindings :: ( [ Doc ] ) } +{-# INLINABLE wrap_FunctionBindings #-} +wrap_FunctionBindings :: T_FunctionBindings -> Inh_FunctionBindings -> (Syn_FunctionBindings ) +wrap_FunctionBindings (T_FunctionBindings act) (Inh_FunctionBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_FunctionBindings_vIn58 + (T_FunctionBindings_vOut58 _lhsOtext) <- return (inv_FunctionBindings_s59 sem arg) + return (Syn_FunctionBindings _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_FunctionBindings #-} +sem_FunctionBindings :: FunctionBindings -> T_FunctionBindings +sem_FunctionBindings list = Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list) + +-- semantic domain +newtype T_FunctionBindings = T_FunctionBindings { + attach_T_FunctionBindings :: Identity (T_FunctionBindings_s59 ) + } +newtype T_FunctionBindings_s59 = C_FunctionBindings_s59 { + inv_FunctionBindings_s59 :: (T_FunctionBindings_v58 ) + } +data T_FunctionBindings_s60 = C_FunctionBindings_s60 +type T_FunctionBindings_v58 = (T_FunctionBindings_vIn58 ) -> (T_FunctionBindings_vOut58 ) +data T_FunctionBindings_vIn58 = T_FunctionBindings_vIn58 +data T_FunctionBindings_vOut58 = T_FunctionBindings_vOut58 ( [ Doc ] ) +{-# NOINLINE sem_FunctionBindings_Cons #-} +sem_FunctionBindings_Cons :: T_FunctionBinding -> T_FunctionBindings -> T_FunctionBindings +sem_FunctionBindings_Cons arg_hd_ arg_tl_ = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 ) -> ( let + _hdX56 = Control.Monad.Identity.runIdentity (attach_T_FunctionBinding (arg_hd_)) + _tlX59 = Control.Monad.Identity.runIdentity (attach_T_FunctionBindings (arg_tl_)) + (T_FunctionBinding_vOut55 _hdItext) = inv_FunctionBinding_s56 _hdX56 (T_FunctionBinding_vIn55 ) + (T_FunctionBindings_vOut58 _tlItext) = inv_FunctionBindings_s59 _tlX59 (T_FunctionBindings_vIn58 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule132 _hdItext _tlItext + __result_ = T_FunctionBindings_vOut58 _lhsOtext + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule132 #-} + rule132 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_FunctionBindings_Nil #-} +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = T_FunctionBindings (return st59) where + {-# NOINLINE st59 #-} + st59 = let + v58 :: T_FunctionBindings_v58 + v58 = \ (T_FunctionBindings_vIn58 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule133 () + __result_ = T_FunctionBindings_vOut58 _lhsOtext + in __result_ ) + in C_FunctionBindings_s59 v58 + {-# INLINE rule133 #-} + rule133 = \ (_ :: ()) -> + [] + +-- GuardedExpression ------------------------------------------- +-- wrapper +data Inh_GuardedExpression = Inh_GuardedExpression { } +data Syn_GuardedExpression = Syn_GuardedExpression { text_Syn_GuardedExpression :: ( Doc -> Doc ) } +{-# INLINABLE wrap_GuardedExpression #-} +wrap_GuardedExpression :: T_GuardedExpression -> Inh_GuardedExpression -> (Syn_GuardedExpression ) +wrap_GuardedExpression (T_GuardedExpression act) (Inh_GuardedExpression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpression_vIn61 + (T_GuardedExpression_vOut61 _lhsOtext) <- return (inv_GuardedExpression_s62 sem arg) + return (Syn_GuardedExpression _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_GuardedExpression #-} +sem_GuardedExpression :: GuardedExpression -> T_GuardedExpression +sem_GuardedExpression ( GuardedExpression_GuardedExpression range_ guard_ expression_ ) = sem_GuardedExpression_GuardedExpression ( sem_Range range_ ) ( sem_Expression guard_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_GuardedExpression = T_GuardedExpression { + attach_T_GuardedExpression :: Identity (T_GuardedExpression_s62 ) + } +newtype T_GuardedExpression_s62 = C_GuardedExpression_s62 { + inv_GuardedExpression_s62 :: (T_GuardedExpression_v61 ) + } +data T_GuardedExpression_s63 = C_GuardedExpression_s63 +type T_GuardedExpression_v61 = (T_GuardedExpression_vIn61 ) -> (T_GuardedExpression_vOut61 ) +data T_GuardedExpression_vIn61 = T_GuardedExpression_vIn61 +data T_GuardedExpression_vOut61 = T_GuardedExpression_vOut61 ( Doc -> Doc ) +{-# NOINLINE sem_GuardedExpression_GuardedExpression #-} +sem_GuardedExpression_GuardedExpression :: T_Range -> T_Expression -> T_Expression -> T_GuardedExpression +sem_GuardedExpression_GuardedExpression arg_range_ arg_guard_ arg_expression_ = T_GuardedExpression (return st62) where + {-# NOINLINE st62 #-} + st62 = let + v61 :: T_GuardedExpression_v61 + v61 = \ (T_GuardedExpression_vIn61 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardItext) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _text = rule134 _expressionItext _guardItext + _lhsOtext :: Doc -> Doc + _lhsOtext = rule135 _text + __result_ = T_GuardedExpression_vOut61 _lhsOtext + in __result_ ) + in C_GuardedExpression_s62 v61 + {-# INLINE rule134 #-} + rule134 = \ ((_expressionItext) :: Doc) ((_guardItext) :: Doc) -> + \assign -> text "|" <+> _guardItext <+> assign <+> _expressionItext + {-# INLINE rule135 #-} + rule135 = \ _text -> + _text + +-- GuardedExpressions ------------------------------------------ +-- wrapper +data Inh_GuardedExpressions = Inh_GuardedExpressions { } +data Syn_GuardedExpressions = Syn_GuardedExpressions { text_Syn_GuardedExpressions :: ( [ Doc -> Doc ] ) } +{-# INLINABLE wrap_GuardedExpressions #-} +wrap_GuardedExpressions :: T_GuardedExpressions -> Inh_GuardedExpressions -> (Syn_GuardedExpressions ) +wrap_GuardedExpressions (T_GuardedExpressions act) (Inh_GuardedExpressions ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_GuardedExpressions_vIn64 + (T_GuardedExpressions_vOut64 _lhsOtext) <- return (inv_GuardedExpressions_s65 sem arg) + return (Syn_GuardedExpressions _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_GuardedExpressions #-} +sem_GuardedExpressions :: GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions list = Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list) + +-- semantic domain +newtype T_GuardedExpressions = T_GuardedExpressions { + attach_T_GuardedExpressions :: Identity (T_GuardedExpressions_s65 ) + } +newtype T_GuardedExpressions_s65 = C_GuardedExpressions_s65 { + inv_GuardedExpressions_s65 :: (T_GuardedExpressions_v64 ) + } +data T_GuardedExpressions_s66 = C_GuardedExpressions_s66 +type T_GuardedExpressions_v64 = (T_GuardedExpressions_vIn64 ) -> (T_GuardedExpressions_vOut64 ) +data T_GuardedExpressions_vIn64 = T_GuardedExpressions_vIn64 +data T_GuardedExpressions_vOut64 = T_GuardedExpressions_vOut64 ( [ Doc -> Doc ] ) +{-# NOINLINE sem_GuardedExpressions_Cons #-} +sem_GuardedExpressions_Cons :: T_GuardedExpression -> T_GuardedExpressions -> T_GuardedExpressions +sem_GuardedExpressions_Cons arg_hd_ arg_tl_ = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 ) -> ( let + _hdX62 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpression (arg_hd_)) + _tlX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_tl_)) + (T_GuardedExpression_vOut61 _hdItext) = inv_GuardedExpression_s62 _hdX62 (T_GuardedExpression_vIn61 ) + (T_GuardedExpressions_vOut64 _tlItext) = inv_GuardedExpressions_s65 _tlX65 (T_GuardedExpressions_vIn64 ) + _lhsOtext :: [ Doc -> Doc ] + _lhsOtext = rule136 _hdItext _tlItext + __result_ = T_GuardedExpressions_vOut64 _lhsOtext + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule136 #-} + rule136 = \ ((_hdItext) :: Doc -> Doc ) ((_tlItext) :: [ Doc -> Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_GuardedExpressions_Nil #-} +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = T_GuardedExpressions (return st65) where + {-# NOINLINE st65 #-} + st65 = let + v64 :: T_GuardedExpressions_v64 + v64 = \ (T_GuardedExpressions_vIn64 ) -> ( let + _lhsOtext :: [ Doc -> Doc ] + _lhsOtext = rule137 () + __result_ = T_GuardedExpressions_vOut64 _lhsOtext + in __result_ ) + in C_GuardedExpressions_s65 v64 + {-# INLINE rule137 #-} + rule137 = \ (_ :: ()) -> + [] + +-- Import ------------------------------------------------------ +-- wrapper +data Inh_Import = Inh_Import { } +data Syn_Import = Syn_Import { text_Syn_Import :: (Doc) } +{-# INLINABLE wrap_Import #-} +wrap_Import :: T_Import -> Inh_Import -> (Syn_Import ) +wrap_Import (T_Import act) (Inh_Import ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Import_vIn67 + (T_Import_vOut67 _lhsOtext) <- return (inv_Import_s68 sem arg) + return (Syn_Import _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Import #-} +sem_Import :: Import -> T_Import +sem_Import ( Import_Variable range_ name_ ) = sem_Import_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Import ( Import_TypeOrClass range_ name_ names_ ) = sem_Import_TypeOrClass ( sem_Range range_ ) ( sem_Name name_ ) ( sem_MaybeNames names_ ) +sem_Import ( Import_TypeOrClassComplete range_ name_ ) = sem_Import_TypeOrClassComplete ( sem_Range range_ ) ( sem_Name name_ ) + +-- semantic domain +newtype T_Import = T_Import { + attach_T_Import :: Identity (T_Import_s68 ) + } +newtype T_Import_s68 = C_Import_s68 { + inv_Import_s68 :: (T_Import_v67 ) + } +data T_Import_s69 = C_Import_s69 +type T_Import_v67 = (T_Import_vIn67 ) -> (T_Import_vOut67 ) +data T_Import_vIn67 = T_Import_vIn67 +data T_Import_vOut67 = T_Import_vOut67 (Doc) +{-# NOINLINE sem_Import_Variable #-} +sem_Import_Variable :: T_Range -> T_Name -> T_Import +sem_Import_Variable arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _text = rule138 _nameItext + _lhsOtext :: Doc + _lhsOtext = rule139 _text + __result_ = T_Import_vOut67 _lhsOtext + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule138 #-} + rule138 = \ ((_nameItext) :: Doc) -> + _nameItext + {-# INLINE rule139 #-} + rule139 = \ _text -> + _text +{-# NOINLINE sem_Import_TypeOrClass #-} +sem_Import_TypeOrClass :: T_Range -> T_Name -> T_MaybeNames -> T_Import +sem_Import_TypeOrClass arg_range_ arg_name_ arg_names_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _namesX107 = Control.Monad.Identity.runIdentity (attach_T_MaybeNames (arg_names_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeNames_vOut106 _namesItext) = inv_MaybeNames_s107 _namesX107 (T_MaybeNames_vIn106 ) + _text = rule140 _nameItext _namesItext + _lhsOtext :: Doc + _lhsOtext = rule141 _text + __result_ = T_Import_vOut67 _lhsOtext + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule140 #-} + rule140 = \ ((_nameItext) :: Doc) ((_namesItext) :: Maybe [ Doc ] ) -> + _nameItext <> maybe empty tupled1 _namesItext + {-# INLINE rule141 #-} + rule141 = \ _text -> + _text +{-# NOINLINE sem_Import_TypeOrClassComplete #-} +sem_Import_TypeOrClassComplete :: T_Range -> T_Name -> T_Import +sem_Import_TypeOrClassComplete arg_range_ arg_name_ = T_Import (return st68) where + {-# NOINLINE st68 #-} + st68 = let + v67 :: T_Import_v67 + v67 = \ (T_Import_vIn67 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _text = rule142 _nameItext + _lhsOtext :: Doc + _lhsOtext = rule143 _text + __result_ = T_Import_vOut67 _lhsOtext + in __result_ ) + in C_Import_s68 v67 + {-# INLINE rule142 #-} + rule142 = \ ((_nameItext) :: Doc) -> + _nameItext + {-# INLINE rule143 #-} + rule143 = \ _text -> + _text + +-- ImportDeclaration ------------------------------------------- +-- wrapper +data Inh_ImportDeclaration = Inh_ImportDeclaration { } +data Syn_ImportDeclaration = Syn_ImportDeclaration { text_Syn_ImportDeclaration :: (Doc) } +{-# INLINABLE wrap_ImportDeclaration #-} +wrap_ImportDeclaration :: T_ImportDeclaration -> Inh_ImportDeclaration -> (Syn_ImportDeclaration ) +wrap_ImportDeclaration (T_ImportDeclaration act) (Inh_ImportDeclaration ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclaration_vIn70 + (T_ImportDeclaration_vOut70 _lhsOtext) <- return (inv_ImportDeclaration_s71 sem arg) + return (Syn_ImportDeclaration _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_ImportDeclaration #-} +sem_ImportDeclaration :: ImportDeclaration -> T_ImportDeclaration +sem_ImportDeclaration ( ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ ) = sem_ImportDeclaration_Import ( sem_Range range_ ) qualified_ ( sem_Name name_ ) ( sem_MaybeName asname_ ) ( sem_MaybeImportSpecification importspecification_ ) +sem_ImportDeclaration ( ImportDeclaration_Empty range_ ) = sem_ImportDeclaration_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_ImportDeclaration = T_ImportDeclaration { + attach_T_ImportDeclaration :: Identity (T_ImportDeclaration_s71 ) + } +newtype T_ImportDeclaration_s71 = C_ImportDeclaration_s71 { + inv_ImportDeclaration_s71 :: (T_ImportDeclaration_v70 ) + } +data T_ImportDeclaration_s72 = C_ImportDeclaration_s72 +type T_ImportDeclaration_v70 = (T_ImportDeclaration_vIn70 ) -> (T_ImportDeclaration_vOut70 ) +data T_ImportDeclaration_vIn70 = T_ImportDeclaration_vIn70 +data T_ImportDeclaration_vOut70 = T_ImportDeclaration_vOut70 (Doc) +{-# NOINLINE sem_ImportDeclaration_Import #-} +sem_ImportDeclaration_Import :: T_Range -> (Bool) -> T_Name -> T_MaybeName -> T_MaybeImportSpecification -> T_ImportDeclaration +sem_ImportDeclaration_Import arg_range_ arg_qualified_ arg_name_ arg_asname_ arg_importspecification_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _asnameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_asname_)) + _importspecificationX98 = Control.Monad.Identity.runIdentity (attach_T_MaybeImportSpecification (arg_importspecification_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_MaybeName_vOut103 _asnameItext) = inv_MaybeName_s104 _asnameX104 (T_MaybeName_vIn103 ) + (T_MaybeImportSpecification_vOut97 _importspecificationItext) = inv_MaybeImportSpecification_s98 _importspecificationX98 (T_MaybeImportSpecification_vIn97 ) + _text = rule144 _importspecificationItext _nameItext arg_qualified_ + _lhsOtext :: Doc + _lhsOtext = rule145 _text + __result_ = T_ImportDeclaration_vOut70 _lhsOtext + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule144 #-} + rule144 = \ ((_importspecificationItext) :: Maybe Doc ) ((_nameItext) :: Doc) qualified_ -> + text "import" <+> (if qualified_ then (text "qualified" <+>) else id) _nameItext <+> maybe empty id _importspecificationItext + {-# INLINE rule145 #-} + rule145 = \ _text -> + _text +{-# NOINLINE sem_ImportDeclaration_Empty #-} +sem_ImportDeclaration_Empty :: T_Range -> T_ImportDeclaration +sem_ImportDeclaration_Empty arg_range_ = T_ImportDeclaration (return st71) where + {-# NOINLINE st71 #-} + st71 = let + v70 :: T_ImportDeclaration_v70 + v70 = \ (T_ImportDeclaration_vIn70 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule146 () + _lhsOtext :: Doc + _lhsOtext = rule147 _text + __result_ = T_ImportDeclaration_vOut70 _lhsOtext + in __result_ ) + in C_ImportDeclaration_s71 v70 + {-# INLINE rule146 #-} + rule146 = \ (_ :: ()) -> + empty + {-# INLINE rule147 #-} + rule147 = \ _text -> + _text + +-- ImportDeclarations ------------------------------------------ +-- wrapper +data Inh_ImportDeclarations = Inh_ImportDeclarations { } +data Syn_ImportDeclarations = Syn_ImportDeclarations { text_Syn_ImportDeclarations :: ( [ Doc ] ) } +{-# INLINABLE wrap_ImportDeclarations #-} +wrap_ImportDeclarations :: T_ImportDeclarations -> Inh_ImportDeclarations -> (Syn_ImportDeclarations ) +wrap_ImportDeclarations (T_ImportDeclarations act) (Inh_ImportDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportDeclarations_vIn73 + (T_ImportDeclarations_vOut73 _lhsOtext) <- return (inv_ImportDeclarations_s74 sem arg) + return (Syn_ImportDeclarations _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_ImportDeclarations #-} +sem_ImportDeclarations :: ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations list = Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list) + +-- semantic domain +newtype T_ImportDeclarations = T_ImportDeclarations { + attach_T_ImportDeclarations :: Identity (T_ImportDeclarations_s74 ) + } +newtype T_ImportDeclarations_s74 = C_ImportDeclarations_s74 { + inv_ImportDeclarations_s74 :: (T_ImportDeclarations_v73 ) + } +data T_ImportDeclarations_s75 = C_ImportDeclarations_s75 +type T_ImportDeclarations_v73 = (T_ImportDeclarations_vIn73 ) -> (T_ImportDeclarations_vOut73 ) +data T_ImportDeclarations_vIn73 = T_ImportDeclarations_vIn73 +data T_ImportDeclarations_vOut73 = T_ImportDeclarations_vOut73 ( [ Doc ] ) +{-# NOINLINE sem_ImportDeclarations_Cons #-} +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> T_ImportDeclarations -> T_ImportDeclarations +sem_ImportDeclarations_Cons arg_hd_ arg_tl_ = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _hdX71 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclaration (arg_hd_)) + _tlX74 = Control.Monad.Identity.runIdentity (attach_T_ImportDeclarations (arg_tl_)) + (T_ImportDeclaration_vOut70 _hdItext) = inv_ImportDeclaration_s71 _hdX71 (T_ImportDeclaration_vIn70 ) + (T_ImportDeclarations_vOut73 _tlItext) = inv_ImportDeclarations_s74 _tlX74 (T_ImportDeclarations_vIn73 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule148 _hdItext _tlItext + __result_ = T_ImportDeclarations_vOut73 _lhsOtext + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule148 #-} + rule148 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_ImportDeclarations_Nil #-} +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = T_ImportDeclarations (return st74) where + {-# NOINLINE st74 #-} + st74 = let + v73 :: T_ImportDeclarations_v73 + v73 = \ (T_ImportDeclarations_vIn73 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule149 () + __result_ = T_ImportDeclarations_vOut73 _lhsOtext + in __result_ ) + in C_ImportDeclarations_s74 v73 + {-# INLINE rule149 #-} + rule149 = \ (_ :: ()) -> + [] + +-- ImportSpecification ----------------------------------------- +-- wrapper +data Inh_ImportSpecification = Inh_ImportSpecification { } +data Syn_ImportSpecification = Syn_ImportSpecification { text_Syn_ImportSpecification :: (Doc) } +{-# INLINABLE wrap_ImportSpecification #-} +wrap_ImportSpecification :: T_ImportSpecification -> Inh_ImportSpecification -> (Syn_ImportSpecification ) +wrap_ImportSpecification (T_ImportSpecification act) (Inh_ImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_ImportSpecification_vIn76 + (T_ImportSpecification_vOut76 _lhsOtext) <- return (inv_ImportSpecification_s77 sem arg) + return (Syn_ImportSpecification _lhsOtext) + ) + +-- cata +{-# INLINE sem_ImportSpecification #-} +sem_ImportSpecification :: ImportSpecification -> T_ImportSpecification +sem_ImportSpecification ( ImportSpecification_Import range_ hiding_ imports_ ) = sem_ImportSpecification_Import ( sem_Range range_ ) hiding_ ( sem_Imports imports_ ) + +-- semantic domain +newtype T_ImportSpecification = T_ImportSpecification { + attach_T_ImportSpecification :: Identity (T_ImportSpecification_s77 ) + } +newtype T_ImportSpecification_s77 = C_ImportSpecification_s77 { + inv_ImportSpecification_s77 :: (T_ImportSpecification_v76 ) + } +data T_ImportSpecification_s78 = C_ImportSpecification_s78 +type T_ImportSpecification_v76 = (T_ImportSpecification_vIn76 ) -> (T_ImportSpecification_vOut76 ) +data T_ImportSpecification_vIn76 = T_ImportSpecification_vIn76 +data T_ImportSpecification_vOut76 = T_ImportSpecification_vOut76 (Doc) +{-# NOINLINE sem_ImportSpecification_Import #-} +sem_ImportSpecification_Import :: T_Range -> (Bool) -> T_Imports -> T_ImportSpecification +sem_ImportSpecification_Import arg_range_ arg_hiding_ arg_imports_ = T_ImportSpecification (return st77) where + {-# NOINLINE st77 #-} + st77 = let + v76 :: T_ImportSpecification_v76 + v76 = \ (T_ImportSpecification_vIn76 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _importsX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_imports_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Imports_vOut79 _importsItext) = inv_Imports_s80 _importsX80 (T_Imports_vIn79 ) + _text = rule150 _importsItext arg_hiding_ + _lhsOtext :: Doc + _lhsOtext = rule151 _text + __result_ = T_ImportSpecification_vOut76 _lhsOtext + in __result_ ) + in C_ImportSpecification_s77 v76 + {-# INLINE rule150 #-} + rule150 = \ ((_importsItext) :: [ Doc ] ) hiding_ -> + (if hiding_ then (text "hiding" <+>) else id) + (tupled _importsItext) + {-# INLINE rule151 #-} + rule151 = \ _text -> + _text + +-- Imports ----------------------------------------------------- +-- wrapper +data Inh_Imports = Inh_Imports { } +data Syn_Imports = Syn_Imports { text_Syn_Imports :: ( [ Doc ] ) } +{-# INLINABLE wrap_Imports #-} +wrap_Imports :: T_Imports -> Inh_Imports -> (Syn_Imports ) +wrap_Imports (T_Imports act) (Inh_Imports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Imports_vIn79 + (T_Imports_vOut79 _lhsOtext) <- return (inv_Imports_s80 sem arg) + return (Syn_Imports _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Imports #-} +sem_Imports :: Imports -> T_Imports +sem_Imports list = Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list) + +-- semantic domain +newtype T_Imports = T_Imports { + attach_T_Imports :: Identity (T_Imports_s80 ) + } +newtype T_Imports_s80 = C_Imports_s80 { + inv_Imports_s80 :: (T_Imports_v79 ) + } +data T_Imports_s81 = C_Imports_s81 +type T_Imports_v79 = (T_Imports_vIn79 ) -> (T_Imports_vOut79 ) +data T_Imports_vIn79 = T_Imports_vIn79 +data T_Imports_vOut79 = T_Imports_vOut79 ( [ Doc ] ) +{-# NOINLINE sem_Imports_Cons #-} +sem_Imports_Cons :: T_Import -> T_Imports -> T_Imports +sem_Imports_Cons arg_hd_ arg_tl_ = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _hdX68 = Control.Monad.Identity.runIdentity (attach_T_Import (arg_hd_)) + _tlX80 = Control.Monad.Identity.runIdentity (attach_T_Imports (arg_tl_)) + (T_Import_vOut67 _hdItext) = inv_Import_s68 _hdX68 (T_Import_vIn67 ) + (T_Imports_vOut79 _tlItext) = inv_Imports_s80 _tlX80 (T_Imports_vIn79 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule152 _hdItext _tlItext + __result_ = T_Imports_vOut79 _lhsOtext + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule152 #-} + rule152 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_Imports_Nil #-} +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = T_Imports (return st80) where + {-# NOINLINE st80 #-} + st80 = let + v79 :: T_Imports_v79 + v79 = \ (T_Imports_vIn79 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule153 () + __result_ = T_Imports_vOut79 _lhsOtext + in __result_ ) + in C_Imports_s80 v79 + {-# INLINE rule153 #-} + rule153 = \ (_ :: ()) -> + [] + +-- LeftHandSide ------------------------------------------------ +-- wrapper +data Inh_LeftHandSide = Inh_LeftHandSide { } +data Syn_LeftHandSide = Syn_LeftHandSide { text_Syn_LeftHandSide :: (Doc) } +{-# INLINABLE wrap_LeftHandSide #-} +wrap_LeftHandSide :: T_LeftHandSide -> Inh_LeftHandSide -> (Syn_LeftHandSide ) +wrap_LeftHandSide (T_LeftHandSide act) (Inh_LeftHandSide ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_LeftHandSide_vIn82 + (T_LeftHandSide_vOut82 _lhsOtext) <- return (inv_LeftHandSide_s83 sem arg) + return (Syn_LeftHandSide _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_LeftHandSide #-} +sem_LeftHandSide :: LeftHandSide -> T_LeftHandSide +sem_LeftHandSide ( LeftHandSide_Function range_ name_ patterns_ ) = sem_LeftHandSide_Function ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_LeftHandSide ( LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ ) = sem_LeftHandSide_Infix ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name operator_ ) ( sem_Pattern rightPattern_ ) +sem_LeftHandSide ( LeftHandSide_Parenthesized range_ lefthandside_ patterns_ ) = sem_LeftHandSide_Parenthesized ( sem_Range range_ ) ( sem_LeftHandSide lefthandside_ ) ( sem_Patterns patterns_ ) + +-- semantic domain +newtype T_LeftHandSide = T_LeftHandSide { + attach_T_LeftHandSide :: Identity (T_LeftHandSide_s83 ) + } +newtype T_LeftHandSide_s83 = C_LeftHandSide_s83 { + inv_LeftHandSide_s83 :: (T_LeftHandSide_v82 ) + } +data T_LeftHandSide_s84 = C_LeftHandSide_s84 +type T_LeftHandSide_v82 = (T_LeftHandSide_vIn82 ) -> (T_LeftHandSide_vOut82 ) +data T_LeftHandSide_vIn82 = T_LeftHandSide_vIn82 +data T_LeftHandSide_vOut82 = T_LeftHandSide_vOut82 (Doc) +{-# NOINLINE sem_LeftHandSide_Function #-} +sem_LeftHandSide_Function :: T_Range -> T_Name -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Function arg_range_ arg_name_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsItext) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _text = rule154 _nameIisOperator _nameItext _patternsItext + _lhsOtext :: Doc + _lhsOtext = rule155 _text + __result_ = T_LeftHandSide_vOut82 _lhsOtext + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule154 #-} + rule154 = \ ((_nameIisOperator) :: Bool) ((_nameItext) :: Doc) ((_patternsItext) :: [ Doc ] ) -> + foldl (<+>) (parensIf _nameIisOperator _nameItext) _patternsItext + {-# INLINE rule155 #-} + rule155 = \ _text -> + _text +{-# NOINLINE sem_LeftHandSide_Infix #-} +sem_LeftHandSide_Infix :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_LeftHandSide +sem_LeftHandSide_Infix arg_range_ arg_leftPattern_ arg_operator_ arg_rightPattern_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _operatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_operator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternItext) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 ) + (T_Name_vOut112 _operatorIisIdentifier _operatorIisOperator _operatorIisSpecial _operatorItext) = inv_Name_s113 _operatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternItext) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 ) + _text = rule156 _leftPatternItext _operatorIisOperator _operatorItext _rightPatternItext + _lhsOtext :: Doc + _lhsOtext = rule157 _text + __result_ = T_LeftHandSide_vOut82 _lhsOtext + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule156 #-} + rule156 = \ ((_leftPatternItext) :: Doc) ((_operatorIisOperator) :: Bool) ((_operatorItext) :: Doc) ((_rightPatternItext) :: Doc) -> + _leftPatternItext <+> backQuotesIf (not _operatorIisOperator) _operatorItext <+> _rightPatternItext + {-# INLINE rule157 #-} + rule157 = \ _text -> + _text +{-# NOINLINE sem_LeftHandSide_Parenthesized #-} +sem_LeftHandSide_Parenthesized :: T_Range -> T_LeftHandSide -> T_Patterns -> T_LeftHandSide +sem_LeftHandSide_Parenthesized arg_range_ arg_lefthandside_ arg_patterns_ = T_LeftHandSide (return st83) where + {-# NOINLINE st83 #-} + st83 = let + v82 :: T_LeftHandSide_v82 + v82 = \ (T_LeftHandSide_vIn82 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _lefthandsideX83 = Control.Monad.Identity.runIdentity (attach_T_LeftHandSide (arg_lefthandside_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_LeftHandSide_vOut82 _lefthandsideItext) = inv_LeftHandSide_s83 _lefthandsideX83 (T_LeftHandSide_vIn82 ) + (T_Patterns_vOut121 _patternsItext) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _text = rule158 _lefthandsideItext _patternsItext + _lhsOtext :: Doc + _lhsOtext = rule159 _text + __result_ = T_LeftHandSide_vOut82 _lhsOtext + in __result_ ) + in C_LeftHandSide_s83 v82 + {-# INLINE rule158 #-} + rule158 = \ ((_lefthandsideItext) :: Doc) ((_patternsItext) :: [ Doc ] ) -> + foldl (<+>) (parens _lefthandsideItext) _patternsItext + {-# INLINE rule159 #-} + rule159 = \ _text -> + _text + +-- Literal ----------------------------------------------------- +-- wrapper +data Inh_Literal = Inh_Literal { } +data Syn_Literal = Syn_Literal { text_Syn_Literal :: (Doc) } +{-# INLINABLE wrap_Literal #-} +wrap_Literal :: T_Literal -> Inh_Literal -> (Syn_Literal ) +wrap_Literal (T_Literal act) (Inh_Literal ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Literal_vIn85 + (T_Literal_vOut85 _lhsOtext) <- return (inv_Literal_s86 sem arg) + return (Syn_Literal _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Literal #-} +sem_Literal :: Literal -> T_Literal +sem_Literal ( Literal_Int range_ value_ ) = sem_Literal_Int ( sem_Range range_ ) value_ +sem_Literal ( Literal_Char range_ value_ ) = sem_Literal_Char ( sem_Range range_ ) value_ +sem_Literal ( Literal_Float range_ value_ ) = sem_Literal_Float ( sem_Range range_ ) value_ +sem_Literal ( Literal_String range_ value_ ) = sem_Literal_String ( sem_Range range_ ) value_ + +-- semantic domain +newtype T_Literal = T_Literal { + attach_T_Literal :: Identity (T_Literal_s86 ) + } +newtype T_Literal_s86 = C_Literal_s86 { + inv_Literal_s86 :: (T_Literal_v85 ) + } +data T_Literal_s87 = C_Literal_s87 +type T_Literal_v85 = (T_Literal_vIn85 ) -> (T_Literal_vOut85 ) +data T_Literal_vIn85 = T_Literal_vIn85 +data T_Literal_vOut85 = T_Literal_vOut85 (Doc) +{-# NOINLINE sem_Literal_Int #-} +sem_Literal_Int :: T_Range -> (String) -> T_Literal +sem_Literal_Int arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule160 arg_value_ + _lhsOtext :: Doc + _lhsOtext = rule161 _text + __result_ = T_Literal_vOut85 _lhsOtext + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule160 #-} + rule160 = \ value_ -> + text value_ + {-# INLINE rule161 #-} + rule161 = \ _text -> + _text +{-# NOINLINE sem_Literal_Char #-} +sem_Literal_Char :: T_Range -> (String) -> T_Literal +sem_Literal_Char arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule162 arg_value_ + _lhsOtext :: Doc + _lhsOtext = rule163 _text + __result_ = T_Literal_vOut85 _lhsOtext + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule162 #-} + rule162 = \ value_ -> + text ("'" ++ value_ ++ "'") + {-# INLINE rule163 #-} + rule163 = \ _text -> + _text +{-# NOINLINE sem_Literal_Float #-} +sem_Literal_Float :: T_Range -> (String) -> T_Literal +sem_Literal_Float arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule164 arg_value_ + _lhsOtext :: Doc + _lhsOtext = rule165 _text + __result_ = T_Literal_vOut85 _lhsOtext + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule164 #-} + rule164 = \ value_ -> + text value_ + {-# INLINE rule165 #-} + rule165 = \ _text -> + _text +{-# NOINLINE sem_Literal_String #-} +sem_Literal_String :: T_Range -> (String) -> T_Literal +sem_Literal_String arg_range_ arg_value_ = T_Literal (return st86) where + {-# NOINLINE st86 #-} + st86 = let + v85 :: T_Literal_v85 + v85 = \ (T_Literal_vIn85 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule166 arg_value_ + _lhsOtext :: Doc + _lhsOtext = rule167 _text + __result_ = T_Literal_vOut85 _lhsOtext + in __result_ ) + in C_Literal_s86 v85 + {-# INLINE rule166 #-} + rule166 = \ value_ -> + text ("\"" ++ value_ ++ "\"") + {-# INLINE rule167 #-} + rule167 = \ _text -> + _text + +-- MaybeDeclarations ------------------------------------------- +-- wrapper +data Inh_MaybeDeclarations = Inh_MaybeDeclarations { } +data Syn_MaybeDeclarations = Syn_MaybeDeclarations { text_Syn_MaybeDeclarations :: ( Maybe [ Doc ] ) } +{-# INLINABLE wrap_MaybeDeclarations #-} +wrap_MaybeDeclarations :: T_MaybeDeclarations -> Inh_MaybeDeclarations -> (Syn_MaybeDeclarations ) +wrap_MaybeDeclarations (T_MaybeDeclarations act) (Inh_MaybeDeclarations ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeDeclarations_vIn88 + (T_MaybeDeclarations_vOut88 _lhsOtext) <- return (inv_MaybeDeclarations_s89 sem arg) + return (Syn_MaybeDeclarations _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_MaybeDeclarations #-} +sem_MaybeDeclarations :: MaybeDeclarations -> T_MaybeDeclarations +sem_MaybeDeclarations ( MaybeDeclarations_Nothing ) = sem_MaybeDeclarations_Nothing +sem_MaybeDeclarations ( MaybeDeclarations_Just declarations_ ) = sem_MaybeDeclarations_Just ( sem_Declarations declarations_ ) + +-- semantic domain +newtype T_MaybeDeclarations = T_MaybeDeclarations { + attach_T_MaybeDeclarations :: Identity (T_MaybeDeclarations_s89 ) + } +newtype T_MaybeDeclarations_s89 = C_MaybeDeclarations_s89 { + inv_MaybeDeclarations_s89 :: (T_MaybeDeclarations_v88 ) + } +data T_MaybeDeclarations_s90 = C_MaybeDeclarations_s90 +type T_MaybeDeclarations_v88 = (T_MaybeDeclarations_vIn88 ) -> (T_MaybeDeclarations_vOut88 ) +data T_MaybeDeclarations_vIn88 = T_MaybeDeclarations_vIn88 +data T_MaybeDeclarations_vOut88 = T_MaybeDeclarations_vOut88 ( Maybe [ Doc ] ) +{-# NOINLINE sem_MaybeDeclarations_Nothing #-} +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 ) -> ( let + _text = rule168 () + _lhsOtext :: Maybe [ Doc ] + _lhsOtext = rule169 _text + __result_ = T_MaybeDeclarations_vOut88 _lhsOtext + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule168 #-} + rule168 = \ (_ :: ()) -> + Nothing + {-# INLINE rule169 #-} + rule169 = \ _text -> + _text +{-# NOINLINE sem_MaybeDeclarations_Just #-} +sem_MaybeDeclarations_Just :: T_Declarations -> T_MaybeDeclarations +sem_MaybeDeclarations_Just arg_declarations_ = T_MaybeDeclarations (return st89) where + {-# NOINLINE st89 #-} + st89 = let + v88 :: T_MaybeDeclarations_v88 + v88 = \ (T_MaybeDeclarations_vIn88 ) -> ( let + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Declarations_vOut31 _declarationsItext) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _text = rule170 _declarationsItext + _lhsOtext :: Maybe [ Doc ] + _lhsOtext = rule171 _text + __result_ = T_MaybeDeclarations_vOut88 _lhsOtext + in __result_ ) + in C_MaybeDeclarations_s89 v88 + {-# INLINE rule170 #-} + rule170 = \ ((_declarationsItext) :: [ Doc ] ) -> + case filter ((/= "") . show) _declarationsItext of + [] -> Nothing + xs -> Just xs + {-# INLINE rule171 #-} + rule171 = \ _text -> + _text + +-- MaybeExports ------------------------------------------------ +-- wrapper +data Inh_MaybeExports = Inh_MaybeExports { } +data Syn_MaybeExports = Syn_MaybeExports { text_Syn_MaybeExports :: ( Maybe [ Doc ] ) } +{-# INLINABLE wrap_MaybeExports #-} +wrap_MaybeExports :: T_MaybeExports -> Inh_MaybeExports -> (Syn_MaybeExports ) +wrap_MaybeExports (T_MaybeExports act) (Inh_MaybeExports ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExports_vIn91 + (T_MaybeExports_vOut91 _lhsOtext) <- return (inv_MaybeExports_s92 sem arg) + return (Syn_MaybeExports _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_MaybeExports #-} +sem_MaybeExports :: MaybeExports -> T_MaybeExports +sem_MaybeExports ( MaybeExports_Nothing ) = sem_MaybeExports_Nothing +sem_MaybeExports ( MaybeExports_Just exports_ ) = sem_MaybeExports_Just ( sem_Exports exports_ ) + +-- semantic domain +newtype T_MaybeExports = T_MaybeExports { + attach_T_MaybeExports :: Identity (T_MaybeExports_s92 ) + } +newtype T_MaybeExports_s92 = C_MaybeExports_s92 { + inv_MaybeExports_s92 :: (T_MaybeExports_v91 ) + } +data T_MaybeExports_s93 = C_MaybeExports_s93 +type T_MaybeExports_v91 = (T_MaybeExports_vIn91 ) -> (T_MaybeExports_vOut91 ) +data T_MaybeExports_vIn91 = T_MaybeExports_vIn91 +data T_MaybeExports_vOut91 = T_MaybeExports_vOut91 ( Maybe [ Doc ] ) +{-# NOINLINE sem_MaybeExports_Nothing #-} +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _text = rule172 () + _lhsOtext :: Maybe [ Doc ] + _lhsOtext = rule173 _text + __result_ = T_MaybeExports_vOut91 _lhsOtext + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule172 #-} + rule172 = \ (_ :: ()) -> + Nothing + {-# INLINE rule173 #-} + rule173 = \ _text -> + _text +{-# NOINLINE sem_MaybeExports_Just #-} +sem_MaybeExports_Just :: T_Exports -> T_MaybeExports +sem_MaybeExports_Just arg_exports_ = T_MaybeExports (return st92) where + {-# NOINLINE st92 #-} + st92 = let + v91 :: T_MaybeExports_v91 + v91 = \ (T_MaybeExports_vIn91 ) -> ( let + _exportsX38 = Control.Monad.Identity.runIdentity (attach_T_Exports (arg_exports_)) + (T_Exports_vOut37 _exportsItext) = inv_Exports_s38 _exportsX38 (T_Exports_vIn37 ) + _text = rule174 _exportsItext + _lhsOtext :: Maybe [ Doc ] + _lhsOtext = rule175 _text + __result_ = T_MaybeExports_vOut91 _lhsOtext + in __result_ ) + in C_MaybeExports_s92 v91 + {-# INLINE rule174 #-} + rule174 = \ ((_exportsItext) :: [ Doc ] ) -> + Just _exportsItext + {-# INLINE rule175 #-} + rule175 = \ _text -> + _text + +-- MaybeExpression --------------------------------------------- +-- wrapper +data Inh_MaybeExpression = Inh_MaybeExpression { } +data Syn_MaybeExpression = Syn_MaybeExpression { text_Syn_MaybeExpression :: ( Maybe Doc ) } +{-# INLINABLE wrap_MaybeExpression #-} +wrap_MaybeExpression :: T_MaybeExpression -> Inh_MaybeExpression -> (Syn_MaybeExpression ) +wrap_MaybeExpression (T_MaybeExpression act) (Inh_MaybeExpression ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeExpression_vIn94 + (T_MaybeExpression_vOut94 _lhsOtext) <- return (inv_MaybeExpression_s95 sem arg) + return (Syn_MaybeExpression _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_MaybeExpression #-} +sem_MaybeExpression :: MaybeExpression -> T_MaybeExpression +sem_MaybeExpression ( MaybeExpression_Nothing ) = sem_MaybeExpression_Nothing +sem_MaybeExpression ( MaybeExpression_Just expression_ ) = sem_MaybeExpression_Just ( sem_Expression expression_ ) + +-- semantic domain +newtype T_MaybeExpression = T_MaybeExpression { + attach_T_MaybeExpression :: Identity (T_MaybeExpression_s95 ) + } +newtype T_MaybeExpression_s95 = C_MaybeExpression_s95 { + inv_MaybeExpression_s95 :: (T_MaybeExpression_v94 ) + } +data T_MaybeExpression_s96 = C_MaybeExpression_s96 +type T_MaybeExpression_v94 = (T_MaybeExpression_vIn94 ) -> (T_MaybeExpression_vOut94 ) +data T_MaybeExpression_vIn94 = T_MaybeExpression_vIn94 +data T_MaybeExpression_vOut94 = T_MaybeExpression_vOut94 ( Maybe Doc ) +{-# NOINLINE sem_MaybeExpression_Nothing #-} +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 ) -> ( let + _text = rule176 () + _lhsOtext :: Maybe Doc + _lhsOtext = rule177 _text + __result_ = T_MaybeExpression_vOut94 _lhsOtext + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule176 #-} + rule176 = \ (_ :: ()) -> + Nothing + {-# INLINE rule177 #-} + rule177 = \ _text -> + _text +{-# NOINLINE sem_MaybeExpression_Just #-} +sem_MaybeExpression_Just :: T_Expression -> T_MaybeExpression +sem_MaybeExpression_Just arg_expression_ = T_MaybeExpression (return st95) where + {-# NOINLINE st95 #-} + st95 = let + v94 :: T_MaybeExpression_v94 + v94 = \ (T_MaybeExpression_vIn94 ) -> ( let + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _text = rule178 _expressionItext + _lhsOtext :: Maybe Doc + _lhsOtext = rule179 _text + __result_ = T_MaybeExpression_vOut94 _lhsOtext + in __result_ ) + in C_MaybeExpression_s95 v94 + {-# INLINE rule178 #-} + rule178 = \ ((_expressionItext) :: Doc) -> + Just _expressionItext + {-# INLINE rule179 #-} + rule179 = \ _text -> + _text + +-- MaybeImportSpecification ------------------------------------ +-- wrapper +data Inh_MaybeImportSpecification = Inh_MaybeImportSpecification { } +data Syn_MaybeImportSpecification = Syn_MaybeImportSpecification { text_Syn_MaybeImportSpecification :: ( Maybe Doc ) } +{-# INLINABLE wrap_MaybeImportSpecification #-} +wrap_MaybeImportSpecification :: T_MaybeImportSpecification -> Inh_MaybeImportSpecification -> (Syn_MaybeImportSpecification ) +wrap_MaybeImportSpecification (T_MaybeImportSpecification act) (Inh_MaybeImportSpecification ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeImportSpecification_vIn97 + (T_MaybeImportSpecification_vOut97 _lhsOtext) <- return (inv_MaybeImportSpecification_s98 sem arg) + return (Syn_MaybeImportSpecification _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_MaybeImportSpecification #-} +sem_MaybeImportSpecification :: MaybeImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification ( MaybeImportSpecification_Nothing ) = sem_MaybeImportSpecification_Nothing +sem_MaybeImportSpecification ( MaybeImportSpecification_Just importspecification_ ) = sem_MaybeImportSpecification_Just ( sem_ImportSpecification importspecification_ ) + +-- semantic domain +newtype T_MaybeImportSpecification = T_MaybeImportSpecification { + attach_T_MaybeImportSpecification :: Identity (T_MaybeImportSpecification_s98 ) + } +newtype T_MaybeImportSpecification_s98 = C_MaybeImportSpecification_s98 { + inv_MaybeImportSpecification_s98 :: (T_MaybeImportSpecification_v97 ) + } +data T_MaybeImportSpecification_s99 = C_MaybeImportSpecification_s99 +type T_MaybeImportSpecification_v97 = (T_MaybeImportSpecification_vIn97 ) -> (T_MaybeImportSpecification_vOut97 ) +data T_MaybeImportSpecification_vIn97 = T_MaybeImportSpecification_vIn97 +data T_MaybeImportSpecification_vOut97 = T_MaybeImportSpecification_vOut97 ( Maybe Doc ) +{-# NOINLINE sem_MaybeImportSpecification_Nothing #-} +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _text = rule180 () + _lhsOtext :: Maybe Doc + _lhsOtext = rule181 _text + __result_ = T_MaybeImportSpecification_vOut97 _lhsOtext + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule180 #-} + rule180 = \ (_ :: ()) -> + Nothing + {-# INLINE rule181 #-} + rule181 = \ _text -> + _text +{-# NOINLINE sem_MaybeImportSpecification_Just #-} +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> T_MaybeImportSpecification +sem_MaybeImportSpecification_Just arg_importspecification_ = T_MaybeImportSpecification (return st98) where + {-# NOINLINE st98 #-} + st98 = let + v97 :: T_MaybeImportSpecification_v97 + v97 = \ (T_MaybeImportSpecification_vIn97 ) -> ( let + _importspecificationX77 = Control.Monad.Identity.runIdentity (attach_T_ImportSpecification (arg_importspecification_)) + (T_ImportSpecification_vOut76 _importspecificationItext) = inv_ImportSpecification_s77 _importspecificationX77 (T_ImportSpecification_vIn76 ) + _text = rule182 _importspecificationItext + _lhsOtext :: Maybe Doc + _lhsOtext = rule183 _text + __result_ = T_MaybeImportSpecification_vOut97 _lhsOtext + in __result_ ) + in C_MaybeImportSpecification_s98 v97 + {-# INLINE rule182 #-} + rule182 = \ ((_importspecificationItext) :: Doc) -> + Just _importspecificationItext + {-# INLINE rule183 #-} + rule183 = \ _text -> + _text + +-- MaybeInt ---------------------------------------------------- +-- wrapper +data Inh_MaybeInt = Inh_MaybeInt { } +data Syn_MaybeInt = Syn_MaybeInt { text_Syn_MaybeInt :: ( Maybe Doc ) } +{-# INLINABLE wrap_MaybeInt #-} +wrap_MaybeInt :: T_MaybeInt -> Inh_MaybeInt -> (Syn_MaybeInt ) +wrap_MaybeInt (T_MaybeInt act) (Inh_MaybeInt ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeInt_vIn100 + (T_MaybeInt_vOut100 _lhsOtext) <- return (inv_MaybeInt_s101 sem arg) + return (Syn_MaybeInt _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_MaybeInt #-} +sem_MaybeInt :: MaybeInt -> T_MaybeInt +sem_MaybeInt ( MaybeInt_Nothing ) = sem_MaybeInt_Nothing +sem_MaybeInt ( MaybeInt_Just int_ ) = sem_MaybeInt_Just int_ + +-- semantic domain +newtype T_MaybeInt = T_MaybeInt { + attach_T_MaybeInt :: Identity (T_MaybeInt_s101 ) + } +newtype T_MaybeInt_s101 = C_MaybeInt_s101 { + inv_MaybeInt_s101 :: (T_MaybeInt_v100 ) + } +data T_MaybeInt_s102 = C_MaybeInt_s102 +type T_MaybeInt_v100 = (T_MaybeInt_vIn100 ) -> (T_MaybeInt_vOut100 ) +data T_MaybeInt_vIn100 = T_MaybeInt_vIn100 +data T_MaybeInt_vOut100 = T_MaybeInt_vOut100 ( Maybe Doc ) +{-# NOINLINE sem_MaybeInt_Nothing #-} +sem_MaybeInt_Nothing :: T_MaybeInt +sem_MaybeInt_Nothing = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _text = rule184 () + _lhsOtext :: Maybe Doc + _lhsOtext = rule185 _text + __result_ = T_MaybeInt_vOut100 _lhsOtext + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule184 #-} + rule184 = \ (_ :: ()) -> + Nothing + {-# INLINE rule185 #-} + rule185 = \ _text -> + _text +{-# NOINLINE sem_MaybeInt_Just #-} +sem_MaybeInt_Just :: (Int) -> T_MaybeInt +sem_MaybeInt_Just arg_int_ = T_MaybeInt (return st101) where + {-# NOINLINE st101 #-} + st101 = let + v100 :: T_MaybeInt_v100 + v100 = \ (T_MaybeInt_vIn100 ) -> ( let + _text = rule186 arg_int_ + _lhsOtext :: Maybe Doc + _lhsOtext = rule187 _text + __result_ = T_MaybeInt_vOut100 _lhsOtext + in __result_ ) + in C_MaybeInt_s101 v100 + {-# INLINE rule186 #-} + rule186 = \ int_ -> + Just (int int_) + {-# INLINE rule187 #-} + rule187 = \ _text -> + _text + +-- MaybeName --------------------------------------------------- +-- wrapper +data Inh_MaybeName = Inh_MaybeName { } +data Syn_MaybeName = Syn_MaybeName { text_Syn_MaybeName :: ( Maybe Doc ) } +{-# INLINABLE wrap_MaybeName #-} +wrap_MaybeName :: T_MaybeName -> Inh_MaybeName -> (Syn_MaybeName ) +wrap_MaybeName (T_MaybeName act) (Inh_MaybeName ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeName_vIn103 + (T_MaybeName_vOut103 _lhsOtext) <- return (inv_MaybeName_s104 sem arg) + return (Syn_MaybeName _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_MaybeName #-} +sem_MaybeName :: MaybeName -> T_MaybeName +sem_MaybeName ( MaybeName_Nothing ) = sem_MaybeName_Nothing +sem_MaybeName ( MaybeName_Just name_ ) = sem_MaybeName_Just ( sem_Name name_ ) + +-- semantic domain +newtype T_MaybeName = T_MaybeName { + attach_T_MaybeName :: Identity (T_MaybeName_s104 ) + } +newtype T_MaybeName_s104 = C_MaybeName_s104 { + inv_MaybeName_s104 :: (T_MaybeName_v103 ) + } +data T_MaybeName_s105 = C_MaybeName_s105 +type T_MaybeName_v103 = (T_MaybeName_vIn103 ) -> (T_MaybeName_vOut103 ) +data T_MaybeName_vIn103 = T_MaybeName_vIn103 +data T_MaybeName_vOut103 = T_MaybeName_vOut103 ( Maybe Doc ) +{-# NOINLINE sem_MaybeName_Nothing #-} +sem_MaybeName_Nothing :: T_MaybeName +sem_MaybeName_Nothing = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _text = rule188 () + _lhsOtext :: Maybe Doc + _lhsOtext = rule189 _text + __result_ = T_MaybeName_vOut103 _lhsOtext + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule188 #-} + rule188 = \ (_ :: ()) -> + Nothing + {-# INLINE rule189 #-} + rule189 = \ _text -> + _text +{-# NOINLINE sem_MaybeName_Just #-} +sem_MaybeName_Just :: T_Name -> T_MaybeName +sem_MaybeName_Just arg_name_ = T_MaybeName (return st104) where + {-# NOINLINE st104 #-} + st104 = let + v103 :: T_MaybeName_v103 + v103 = \ (T_MaybeName_vIn103 ) -> ( let + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _text = rule190 _nameItext + _lhsOtext :: Maybe Doc + _lhsOtext = rule191 _text + __result_ = T_MaybeName_vOut103 _lhsOtext + in __result_ ) + in C_MaybeName_s104 v103 + {-# INLINE rule190 #-} + rule190 = \ ((_nameItext) :: Doc) -> + Just _nameItext + {-# INLINE rule191 #-} + rule191 = \ _text -> + _text + +-- MaybeNames -------------------------------------------------- +-- wrapper +data Inh_MaybeNames = Inh_MaybeNames { } +data Syn_MaybeNames = Syn_MaybeNames { text_Syn_MaybeNames :: ( Maybe [ Doc ] ) } +{-# INLINABLE wrap_MaybeNames #-} +wrap_MaybeNames :: T_MaybeNames -> Inh_MaybeNames -> (Syn_MaybeNames ) +wrap_MaybeNames (T_MaybeNames act) (Inh_MaybeNames ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_MaybeNames_vIn106 + (T_MaybeNames_vOut106 _lhsOtext) <- return (inv_MaybeNames_s107 sem arg) + return (Syn_MaybeNames _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_MaybeNames #-} +sem_MaybeNames :: MaybeNames -> T_MaybeNames +sem_MaybeNames ( MaybeNames_Nothing ) = sem_MaybeNames_Nothing +sem_MaybeNames ( MaybeNames_Just names_ ) = sem_MaybeNames_Just ( sem_Names names_ ) + +-- semantic domain +newtype T_MaybeNames = T_MaybeNames { + attach_T_MaybeNames :: Identity (T_MaybeNames_s107 ) + } +newtype T_MaybeNames_s107 = C_MaybeNames_s107 { + inv_MaybeNames_s107 :: (T_MaybeNames_v106 ) + } +data T_MaybeNames_s108 = C_MaybeNames_s108 +type T_MaybeNames_v106 = (T_MaybeNames_vIn106 ) -> (T_MaybeNames_vOut106 ) +data T_MaybeNames_vIn106 = T_MaybeNames_vIn106 +data T_MaybeNames_vOut106 = T_MaybeNames_vOut106 ( Maybe [ Doc ] ) +{-# NOINLINE sem_MaybeNames_Nothing #-} +sem_MaybeNames_Nothing :: T_MaybeNames +sem_MaybeNames_Nothing = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _text = rule192 () + _lhsOtext :: Maybe [ Doc ] + _lhsOtext = rule193 _text + __result_ = T_MaybeNames_vOut106 _lhsOtext + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule192 #-} + rule192 = \ (_ :: ()) -> + Nothing + {-# INLINE rule193 #-} + rule193 = \ _text -> + _text +{-# NOINLINE sem_MaybeNames_Just #-} +sem_MaybeNames_Just :: T_Names -> T_MaybeNames +sem_MaybeNames_Just arg_names_ = T_MaybeNames (return st107) where + {-# NOINLINE st107 #-} + st107 = let + v106 :: T_MaybeNames_v106 + v106 = \ (T_MaybeNames_vIn106 ) -> ( let + _namesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_names_)) + (T_Names_vOut115 _namesIisIdentifier _namesIisOperator _namesIisSpecial _namesItext) = inv_Names_s116 _namesX116 (T_Names_vIn115 ) + _text = rule194 _namesItext + _lhsOtext :: Maybe [ Doc ] + _lhsOtext = rule195 _text + __result_ = T_MaybeNames_vOut106 _lhsOtext + in __result_ ) + in C_MaybeNames_s107 v106 + {-# INLINE rule194 #-} + rule194 = \ ((_namesItext) :: [ Doc ] ) -> + Just _namesItext + {-# INLINE rule195 #-} + rule195 = \ _text -> + _text + +-- Module ------------------------------------------------------ +-- wrapper +data Inh_Module = Inh_Module { } +data Syn_Module = Syn_Module { text_Syn_Module :: (Doc) } +{-# INLINABLE wrap_Module #-} +wrap_Module :: T_Module -> Inh_Module -> (Syn_Module ) +wrap_Module (T_Module act) (Inh_Module ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Module_vIn109 + (T_Module_vOut109 _lhsOtext) <- return (inv_Module_s110 sem arg) + return (Syn_Module _lhsOtext) + ) + +-- cata +{-# INLINE sem_Module #-} +sem_Module :: Module -> T_Module +sem_Module ( Module_Module range_ name_ exports_ body_ ) = sem_Module_Module ( sem_Range range_ ) ( sem_MaybeName name_ ) ( sem_MaybeExports exports_ ) ( sem_Body body_ ) + +-- semantic domain +newtype T_Module = T_Module { + attach_T_Module :: Identity (T_Module_s110 ) + } +newtype T_Module_s110 = C_Module_s110 { + inv_Module_s110 :: (T_Module_v109 ) + } +data T_Module_s111 = C_Module_s111 +type T_Module_v109 = (T_Module_vIn109 ) -> (T_Module_vOut109 ) +data T_Module_vIn109 = T_Module_vIn109 +data T_Module_vOut109 = T_Module_vOut109 (Doc) +{-# NOINLINE sem_Module_Module #-} +sem_Module_Module :: T_Range -> T_MaybeName -> T_MaybeExports -> T_Body -> T_Module +sem_Module_Module arg_range_ arg_name_ arg_exports_ arg_body_ = T_Module (return st110) where + {-# NOINLINE st110 #-} + st110 = let + v109 :: T_Module_v109 + v109 = \ (T_Module_vIn109 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX104 = Control.Monad.Identity.runIdentity (attach_T_MaybeName (arg_name_)) + _exportsX92 = Control.Monad.Identity.runIdentity (attach_T_MaybeExports (arg_exports_)) + _bodyX14 = Control.Monad.Identity.runIdentity (attach_T_Body (arg_body_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_MaybeName_vOut103 _nameItext) = inv_MaybeName_s104 _nameX104 (T_MaybeName_vIn103 ) + (T_MaybeExports_vOut91 _exportsItext) = inv_MaybeExports_s92 _exportsX92 (T_MaybeExports_vIn91 ) + (T_Body_vOut13 _bodyItext) = inv_Body_s14 _bodyX14 (T_Body_vIn13 ) + _text = rule196 _bodyItext _exportsItext _nameItext + _lhsOtext :: Doc + _lhsOtext = rule197 _text + __result_ = T_Module_vOut109 _lhsOtext + in __result_ ) + in C_Module_s110 v109 + {-# INLINE rule196 #-} + rule196 = \ ((_bodyItext) :: Doc) ((_exportsItext) :: Maybe [ Doc ] ) ((_nameItext) :: Maybe Doc ) -> + maybe + id + ( \name body -> + text "module" <+> name <+> + (maybe + (text "where") + (\x -> indent 4 (utrechtList (text "(") (text ")") x <+> text "where")) + _exportsItext + ) + <$> empty <$> + body + ) + _nameItext + _bodyItext + {-# INLINE rule197 #-} + rule197 = \ _text -> + _text + +-- Name -------------------------------------------------------- +-- wrapper +data Inh_Name = Inh_Name { } +data Syn_Name = Syn_Name { isIdentifier_Syn_Name :: (Bool), isOperator_Syn_Name :: (Bool), isSpecial_Syn_Name :: (Bool), text_Syn_Name :: (Doc) } +{-# INLINABLE wrap_Name #-} +wrap_Name :: T_Name -> Inh_Name -> (Syn_Name ) +wrap_Name (T_Name act) (Inh_Name ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Name_vIn112 + (T_Name_vOut112 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOtext) <- return (inv_Name_s113 sem arg) + return (Syn_Name _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Name #-} +sem_Name :: Name -> T_Name +sem_Name ( Name_Identifier range_ module_ name_ ) = sem_Name_Identifier ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Operator range_ module_ name_ ) = sem_Name_Operator ( sem_Range range_ ) ( sem_Strings module_ ) name_ +sem_Name ( Name_Special range_ module_ name_ ) = sem_Name_Special ( sem_Range range_ ) ( sem_Strings module_ ) name_ + +-- semantic domain +newtype T_Name = T_Name { + attach_T_Name :: Identity (T_Name_s113 ) + } +newtype T_Name_s113 = C_Name_s113 { + inv_Name_s113 :: (T_Name_v112 ) + } +data T_Name_s114 = C_Name_s114 +type T_Name_v112 = (T_Name_vIn112 ) -> (T_Name_vOut112 ) +data T_Name_vIn112 = T_Name_vIn112 +data T_Name_vOut112 = T_Name_vOut112 (Bool) (Bool) (Bool) (Doc) +{-# NOINLINE sem_Name_Identifier #-} +sem_Name_Identifier :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Identifier arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleItext) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _text = rule198 arg_name_ + _lhsOisIdentifier :: Bool + _lhsOisIdentifier = rule199 () + _lhsOisOperator :: Bool + _lhsOisOperator = rule200 () + _lhsOisSpecial :: Bool + _lhsOisSpecial = rule201 () + _lhsOtext :: Doc + _lhsOtext = rule202 _text + __result_ = T_Name_vOut112 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOtext + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule198 #-} + rule198 = \ name_ -> + text name_ + {-# INLINE rule199 #-} + rule199 = \ (_ :: ()) -> + True + {-# INLINE rule200 #-} + rule200 = \ (_ :: ()) -> + False + {-# INLINE rule201 #-} + rule201 = \ (_ :: ()) -> + False + {-# INLINE rule202 #-} + rule202 = \ _text -> + _text +{-# NOINLINE sem_Name_Operator #-} +sem_Name_Operator :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Operator arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleItext) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _text = rule203 arg_name_ + _lhsOisOperator :: Bool + _lhsOisOperator = rule204 () + _lhsOisIdentifier :: Bool + _lhsOisIdentifier = rule205 () + _lhsOisSpecial :: Bool + _lhsOisSpecial = rule206 () + _lhsOtext :: Doc + _lhsOtext = rule207 _text + __result_ = T_Name_vOut112 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOtext + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule203 #-} + rule203 = \ name_ -> + text name_ + {-# INLINE rule204 #-} + rule204 = \ (_ :: ()) -> + True + {-# INLINE rule205 #-} + rule205 = \ (_ :: ()) -> + False + {-# INLINE rule206 #-} + rule206 = \ (_ :: ()) -> + False + {-# INLINE rule207 #-} + rule207 = \ _text -> + _text +{-# NOINLINE sem_Name_Special #-} +sem_Name_Special :: T_Range -> T_Strings -> (String) -> T_Name +sem_Name_Special arg_range_ arg_module_ arg_name_ = T_Name (return st113) where + {-# NOINLINE st113 #-} + st113 = let + v112 :: T_Name_v112 + v112 = \ (T_Name_vIn112 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _moduleX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_module_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Strings_vOut160 _moduleItext) = inv_Strings_s161 _moduleX161 (T_Strings_vIn160 ) + _text = rule208 arg_name_ + _lhsOisSpecial :: Bool + _lhsOisSpecial = rule209 () + _lhsOisIdentifier :: Bool + _lhsOisIdentifier = rule210 () + _lhsOisOperator :: Bool + _lhsOisOperator = rule211 () + _lhsOtext :: Doc + _lhsOtext = rule212 _text + __result_ = T_Name_vOut112 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOtext + in __result_ ) + in C_Name_s113 v112 + {-# INLINE rule208 #-} + rule208 = \ name_ -> + text name_ + {-# INLINE rule209 #-} + rule209 = \ (_ :: ()) -> + True + {-# INLINE rule210 #-} + rule210 = \ (_ :: ()) -> + False + {-# INLINE rule211 #-} + rule211 = \ (_ :: ()) -> + False + {-# INLINE rule212 #-} + rule212 = \ _text -> + _text + +-- Names ------------------------------------------------------- +-- wrapper +data Inh_Names = Inh_Names { } +data Syn_Names = Syn_Names { isIdentifier_Syn_Names :: ( [Bool] ), isOperator_Syn_Names :: ( [Bool] ), isSpecial_Syn_Names :: ( [Bool] ), text_Syn_Names :: ( [ Doc ] ) } +{-# INLINABLE wrap_Names #-} +wrap_Names :: T_Names -> Inh_Names -> (Syn_Names ) +wrap_Names (T_Names act) (Inh_Names ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Names_vIn115 + (T_Names_vOut115 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOtext) <- return (inv_Names_s116 sem arg) + return (Syn_Names _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Names #-} +sem_Names :: Names -> T_Names +sem_Names list = Prelude.foldr sem_Names_Cons sem_Names_Nil (Prelude.map sem_Name list) + +-- semantic domain +newtype T_Names = T_Names { + attach_T_Names :: Identity (T_Names_s116 ) + } +newtype T_Names_s116 = C_Names_s116 { + inv_Names_s116 :: (T_Names_v115 ) + } +data T_Names_s117 = C_Names_s117 +type T_Names_v115 = (T_Names_vIn115 ) -> (T_Names_vOut115 ) +data T_Names_vIn115 = T_Names_vIn115 +data T_Names_vOut115 = T_Names_vOut115 ( [Bool] ) ( [Bool] ) ( [Bool] ) ( [ Doc ] ) +{-# NOINLINE sem_Names_Cons #-} +sem_Names_Cons :: T_Name -> T_Names -> T_Names +sem_Names_Cons arg_hd_ arg_tl_ = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _hdX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_hd_)) + _tlX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_tl_)) + (T_Name_vOut112 _hdIisIdentifier _hdIisOperator _hdIisSpecial _hdItext) = inv_Name_s113 _hdX113 (T_Name_vIn112 ) + (T_Names_vOut115 _tlIisIdentifier _tlIisOperator _tlIisSpecial _tlItext) = inv_Names_s116 _tlX116 (T_Names_vIn115 ) + _lhsOisIdentifier :: [Bool] + _lhsOisIdentifier = rule213 _hdIisIdentifier _tlIisIdentifier + _lhsOisOperator :: [Bool] + _lhsOisOperator = rule214 _hdIisOperator _tlIisOperator + _lhsOisSpecial :: [Bool] + _lhsOisSpecial = rule215 _hdIisSpecial _tlIisSpecial + _lhsOtext :: [ Doc ] + _lhsOtext = rule216 _hdItext _tlItext + __result_ = T_Names_vOut115 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOtext + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule213 #-} + rule213 = \ ((_hdIisIdentifier) :: Bool) ((_tlIisIdentifier) :: [Bool] ) -> + _hdIisIdentifier : _tlIisIdentifier + {-# INLINE rule214 #-} + rule214 = \ ((_hdIisOperator) :: Bool) ((_tlIisOperator) :: [Bool] ) -> + _hdIisOperator : _tlIisOperator + {-# INLINE rule215 #-} + rule215 = \ ((_hdIisSpecial) :: Bool) ((_tlIisSpecial) :: [Bool] ) -> + _hdIisSpecial : _tlIisSpecial + {-# INLINE rule216 #-} + rule216 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_Names_Nil #-} +sem_Names_Nil :: T_Names +sem_Names_Nil = T_Names (return st116) where + {-# NOINLINE st116 #-} + st116 = let + v115 :: T_Names_v115 + v115 = \ (T_Names_vIn115 ) -> ( let + _lhsOisIdentifier :: [Bool] + _lhsOisIdentifier = rule217 () + _lhsOisOperator :: [Bool] + _lhsOisOperator = rule218 () + _lhsOisSpecial :: [Bool] + _lhsOisSpecial = rule219 () + _lhsOtext :: [ Doc ] + _lhsOtext = rule220 () + __result_ = T_Names_vOut115 _lhsOisIdentifier _lhsOisOperator _lhsOisSpecial _lhsOtext + in __result_ ) + in C_Names_s116 v115 + {-# INLINE rule217 #-} + rule217 = \ (_ :: ()) -> + [] + {-# INLINE rule218 #-} + rule218 = \ (_ :: ()) -> + [] + {-# INLINE rule219 #-} + rule219 = \ (_ :: ()) -> + [] + {-# INLINE rule220 #-} + rule220 = \ (_ :: ()) -> + [] + +-- Pattern ----------------------------------------------------- +-- wrapper +data Inh_Pattern = Inh_Pattern { } +data Syn_Pattern = Syn_Pattern { text_Syn_Pattern :: (Doc) } +{-# INLINABLE wrap_Pattern #-} +wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) +wrap_Pattern (T_Pattern act) (Inh_Pattern ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Pattern_vIn118 + (T_Pattern_vOut118 _lhsOtext) <- return (inv_Pattern_s119 sem arg) + return (Syn_Pattern _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Pattern #-} +sem_Pattern :: Pattern -> T_Pattern +sem_Pattern ( Pattern_Hole range_ id_ ) = sem_Pattern_Hole ( sem_Range range_ ) id_ +sem_Pattern ( Pattern_Literal range_ literal_ ) = sem_Pattern_Literal ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_Variable range_ name_ ) = sem_Pattern_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Pattern ( Pattern_Constructor range_ name_ patterns_ ) = sem_Pattern_Constructor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Parenthesized range_ pattern_ ) = sem_Pattern_Parenthesized ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ ) = sem_Pattern_InfixConstructor ( sem_Range range_ ) ( sem_Pattern leftPattern_ ) ( sem_Name constructorOperator_ ) ( sem_Pattern rightPattern_ ) +sem_Pattern ( Pattern_List range_ patterns_ ) = sem_Pattern_List ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Tuple range_ patterns_ ) = sem_Pattern_Tuple ( sem_Range range_ ) ( sem_Patterns patterns_ ) +sem_Pattern ( Pattern_Record range_ name_ recordPatternBindings_ ) = sem_Pattern_Record ( sem_Range range_ ) ( sem_Name name_ ) ( sem_RecordPatternBindings recordPatternBindings_ ) +sem_Pattern ( Pattern_Negate range_ literal_ ) = sem_Pattern_Negate ( sem_Range range_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_As range_ name_ pattern_ ) = sem_Pattern_As ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Wildcard range_ ) = sem_Pattern_Wildcard ( sem_Range range_ ) +sem_Pattern ( Pattern_Irrefutable range_ pattern_ ) = sem_Pattern_Irrefutable ( sem_Range range_ ) ( sem_Pattern pattern_ ) +sem_Pattern ( Pattern_Successor range_ name_ literal_ ) = sem_Pattern_Successor ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Literal literal_ ) +sem_Pattern ( Pattern_NegateFloat range_ literal_ ) = sem_Pattern_NegateFloat ( sem_Range range_ ) ( sem_Literal literal_ ) + +-- semantic domain +newtype T_Pattern = T_Pattern { + attach_T_Pattern :: Identity (T_Pattern_s119 ) + } +newtype T_Pattern_s119 = C_Pattern_s119 { + inv_Pattern_s119 :: (T_Pattern_v118 ) + } +data T_Pattern_s120 = C_Pattern_s120 +type T_Pattern_v118 = (T_Pattern_vIn118 ) -> (T_Pattern_vOut118 ) +data T_Pattern_vIn118 = T_Pattern_vIn118 +data T_Pattern_vOut118 = T_Pattern_vOut118 (Doc) +{-# NOINLINE sem_Pattern_Hole #-} +sem_Pattern_Hole :: T_Range -> (Integer) -> T_Pattern +sem_Pattern_Hole arg_range_ _ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule221 () + _lhsOtext :: Doc + _lhsOtext = rule222 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule221 #-} + rule221 = \ (_ :: ()) -> + text hole + {-# INLINE rule222 #-} + rule222 = \ _text -> + _text +{-# NOINLINE sem_Pattern_Literal #-} +sem_Pattern_Literal :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Literal arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalItext) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _text = rule223 _literalItext + _lhsOtext :: Doc + _lhsOtext = rule224 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule223 #-} + rule223 = \ ((_literalItext) :: Doc) -> + _literalItext + {-# INLINE rule224 #-} + rule224 = \ _text -> + _text +{-# NOINLINE sem_Pattern_Variable #-} +sem_Pattern_Variable :: T_Range -> T_Name -> T_Pattern +sem_Pattern_Variable arg_range_ arg_name_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _text = rule225 _nameIisOperator _nameItext + _lhsOtext :: Doc + _lhsOtext = rule226 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule225 #-} + rule225 = \ ((_nameIisOperator) :: Bool) ((_nameItext) :: Doc) -> + parensIf _nameIisOperator _nameItext + {-# INLINE rule226 #-} + rule226 = \ _text -> + _text +{-# NOINLINE sem_Pattern_Constructor #-} +sem_Pattern_Constructor :: T_Range -> T_Name -> T_Patterns -> T_Pattern +sem_Pattern_Constructor arg_range_ arg_name_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Patterns_vOut121 _patternsItext) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _text = rule227 _nameIisOperator _nameItext _patternsItext + _lhsOtext :: Doc + _lhsOtext = rule228 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule227 #-} + rule227 = \ ((_nameIisOperator) :: Bool) ((_nameItext) :: Doc) ((_patternsItext) :: [ Doc ] ) -> + foldl (<+>) (parensIf _nameIisOperator _nameItext) _patternsItext + {-# INLINE rule228 #-} + rule228 = \ _text -> + _text +{-# NOINLINE sem_Pattern_Parenthesized #-} +sem_Pattern_Parenthesized :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Parenthesized arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternItext) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _text = rule229 _patternItext + _lhsOtext :: Doc + _lhsOtext = rule230 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule229 #-} + rule229 = \ ((_patternItext) :: Doc) -> + parens _patternItext + {-# INLINE rule230 #-} + rule230 = \ _text -> + _text +{-# NOINLINE sem_Pattern_InfixConstructor #-} +sem_Pattern_InfixConstructor :: T_Range -> T_Pattern -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_InfixConstructor arg_range_ arg_leftPattern_ arg_constructorOperator_ arg_rightPattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _leftPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_leftPattern_)) + _constructorOperatorX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_constructorOperator_)) + _rightPatternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_rightPattern_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _leftPatternItext) = inv_Pattern_s119 _leftPatternX119 (T_Pattern_vIn118 ) + (T_Name_vOut112 _constructorOperatorIisIdentifier _constructorOperatorIisOperator _constructorOperatorIisSpecial _constructorOperatorItext) = inv_Name_s113 _constructorOperatorX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _rightPatternItext) = inv_Pattern_s119 _rightPatternX119 (T_Pattern_vIn118 ) + _text = rule231 _constructorOperatorItext _leftPatternItext _rightPatternItext + _lhsOtext :: Doc + _lhsOtext = rule232 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule231 #-} + rule231 = \ ((_constructorOperatorItext) :: Doc) ((_leftPatternItext) :: Doc) ((_rightPatternItext) :: Doc) -> + _leftPatternItext <+> _constructorOperatorItext <+> _rightPatternItext + {-# INLINE rule232 #-} + rule232 = \ _text -> + _text +{-# NOINLINE sem_Pattern_List #-} +sem_Pattern_List :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_List arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsItext) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _text = rule233 _patternsItext + _lhsOtext :: Doc + _lhsOtext = rule234 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule233 #-} + rule233 = \ ((_patternsItext) :: [ Doc ] ) -> + PPrint.list _patternsItext + {-# INLINE rule234 #-} + rule234 = \ _text -> + _text +{-# NOINLINE sem_Pattern_Tuple #-} +sem_Pattern_Tuple :: T_Range -> T_Patterns -> T_Pattern +sem_Pattern_Tuple arg_range_ arg_patterns_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternsX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_patterns_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Patterns_vOut121 _patternsItext) = inv_Patterns_s122 _patternsX122 (T_Patterns_vIn121 ) + _text = rule235 _patternsItext + _lhsOtext :: Doc + _lhsOtext = rule236 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule235 #-} + rule235 = \ ((_patternsItext) :: [ Doc ] ) -> + tupled _patternsItext + {-# INLINE rule236 #-} + rule236 = \ _text -> + _text +{-# NOINLINE sem_Pattern_Record #-} +sem_Pattern_Record :: T_Range -> T_Name -> T_RecordPatternBindings -> T_Pattern +sem_Pattern_Record arg_range_ arg_name_ arg_recordPatternBindings_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _recordPatternBindingsX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_recordPatternBindings_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_RecordPatternBindings_vOut145 _recordPatternBindingsItext) = inv_RecordPatternBindings_s146 _recordPatternBindingsX146 (T_RecordPatternBindings_vIn145 ) + _text = rule237 () + _lhsOtext :: Doc + _lhsOtext = rule238 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule237 #-} + rule237 = \ (_ :: ()) -> + text "{- !!! record pattern -}" + {-# INLINE rule238 #-} + rule238 = \ _text -> + _text +{-# NOINLINE sem_Pattern_Negate #-} +sem_Pattern_Negate :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_Negate arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalItext) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _text = rule239 _literalItext + _lhsOtext :: Doc + _lhsOtext = rule240 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule239 #-} + rule239 = \ ((_literalItext) :: Doc) -> + text "-" <> _literalItext + {-# INLINE rule240 #-} + rule240 = \ _text -> + _text +{-# NOINLINE sem_Pattern_As #-} +sem_Pattern_As :: T_Range -> T_Name -> T_Pattern -> T_Pattern +sem_Pattern_As arg_range_ arg_name_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternItext) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _text = rule241 _nameItext _patternItext + _lhsOtext :: Doc + _lhsOtext = rule242 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule241 #-} + rule241 = \ ((_nameItext) :: Doc) ((_patternItext) :: Doc) -> + _nameItext <> text "@" <> _patternItext + {-# INLINE rule242 #-} + rule242 = \ _text -> + _text +{-# NOINLINE sem_Pattern_Wildcard #-} +sem_Pattern_Wildcard :: T_Range -> T_Pattern +sem_Pattern_Wildcard arg_range_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule243 () + _lhsOtext :: Doc + _lhsOtext = rule244 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule243 #-} + rule243 = \ (_ :: ()) -> + text "_" + {-# INLINE rule244 #-} + rule244 = \ _text -> + _text +{-# NOINLINE sem_Pattern_Irrefutable #-} +sem_Pattern_Irrefutable :: T_Range -> T_Pattern -> T_Pattern +sem_Pattern_Irrefutable arg_range_ arg_pattern_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternItext) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _text = rule245 _patternItext + _lhsOtext :: Doc + _lhsOtext = rule246 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule245 #-} + rule245 = \ ((_patternItext) :: Doc) -> + text "~" <> _patternItext + {-# INLINE rule246 #-} + rule246 = \ _text -> + _text +{-# NOINLINE sem_Pattern_Successor #-} +sem_Pattern_Successor :: T_Range -> T_Name -> T_Literal -> T_Pattern +sem_Pattern_Successor arg_range_ arg_name_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Literal_vOut85 _literalItext) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _text = rule247 _literalItext _nameItext + _lhsOtext :: Doc + _lhsOtext = rule248 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule247 #-} + rule247 = \ ((_literalItext) :: Doc) ((_nameItext) :: Doc) -> + _nameItext <+> text "+" <+> _literalItext + {-# INLINE rule248 #-} + rule248 = \ _text -> + _text +{-# NOINLINE sem_Pattern_NegateFloat #-} +sem_Pattern_NegateFloat :: T_Range -> T_Literal -> T_Pattern +sem_Pattern_NegateFloat arg_range_ arg_literal_ = T_Pattern (return st119) where + {-# NOINLINE st119 #-} + st119 = let + v118 :: T_Pattern_v118 + v118 = \ (T_Pattern_vIn118 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _literalX86 = Control.Monad.Identity.runIdentity (attach_T_Literal (arg_literal_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Literal_vOut85 _literalItext) = inv_Literal_s86 _literalX86 (T_Literal_vIn85 ) + _text = rule249 _literalItext + _lhsOtext :: Doc + _lhsOtext = rule250 _text + __result_ = T_Pattern_vOut118 _lhsOtext + in __result_ ) + in C_Pattern_s119 v118 + {-# INLINE rule249 #-} + rule249 = \ ((_literalItext) :: Doc) -> + text "-." <> _literalItext + {-# INLINE rule250 #-} + rule250 = \ _text -> + _text + +-- Patterns ---------------------------------------------------- +-- wrapper +data Inh_Patterns = Inh_Patterns { } +data Syn_Patterns = Syn_Patterns { text_Syn_Patterns :: ( [ Doc ] ) } +{-# INLINABLE wrap_Patterns #-} +wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) +wrap_Patterns (T_Patterns act) (Inh_Patterns ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Patterns_vIn121 + (T_Patterns_vOut121 _lhsOtext) <- return (inv_Patterns_s122 sem arg) + return (Syn_Patterns _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Patterns #-} +sem_Patterns :: Patterns -> T_Patterns +sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) + +-- semantic domain +newtype T_Patterns = T_Patterns { + attach_T_Patterns :: Identity (T_Patterns_s122 ) + } +newtype T_Patterns_s122 = C_Patterns_s122 { + inv_Patterns_s122 :: (T_Patterns_v121 ) + } +data T_Patterns_s123 = C_Patterns_s123 +type T_Patterns_v121 = (T_Patterns_vIn121 ) -> (T_Patterns_vOut121 ) +data T_Patterns_vIn121 = T_Patterns_vIn121 +data T_Patterns_vOut121 = T_Patterns_vOut121 ( [ Doc ] ) +{-# NOINLINE sem_Patterns_Cons #-} +sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns +sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 ) -> ( let + _hdX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) + _tlX122 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) + (T_Pattern_vOut118 _hdItext) = inv_Pattern_s119 _hdX119 (T_Pattern_vIn118 ) + (T_Patterns_vOut121 _tlItext) = inv_Patterns_s122 _tlX122 (T_Patterns_vIn121 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule251 _hdItext _tlItext + __result_ = T_Patterns_vOut121 _lhsOtext + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule251 #-} + rule251 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_Patterns_Nil #-} +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = T_Patterns (return st122) where + {-# NOINLINE st122 #-} + st122 = let + v121 :: T_Patterns_v121 + v121 = \ (T_Patterns_vIn121 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule252 () + __result_ = T_Patterns_vOut121 _lhsOtext + in __result_ ) + in C_Patterns_s122 v121 + {-# INLINE rule252 #-} + rule252 = \ (_ :: ()) -> + [] + +-- Position ---------------------------------------------------- +-- wrapper +data Inh_Position = Inh_Position { } +data Syn_Position = Syn_Position { text_Syn_Position :: (Doc) } +{-# INLINABLE wrap_Position #-} +wrap_Position :: T_Position -> Inh_Position -> (Syn_Position ) +wrap_Position (T_Position act) (Inh_Position ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Position_vIn124 + (T_Position_vOut124 _lhsOtext) <- return (inv_Position_s125 sem arg) + return (Syn_Position _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Position #-} +sem_Position :: Position -> T_Position +sem_Position ( Position_Position filename_ line_ column_ ) = sem_Position_Position filename_ line_ column_ +sem_Position ( Position_Unknown ) = sem_Position_Unknown + +-- semantic domain +newtype T_Position = T_Position { + attach_T_Position :: Identity (T_Position_s125 ) + } +newtype T_Position_s125 = C_Position_s125 { + inv_Position_s125 :: (T_Position_v124 ) + } +data T_Position_s126 = C_Position_s126 +type T_Position_v124 = (T_Position_vIn124 ) -> (T_Position_vOut124 ) +data T_Position_vIn124 = T_Position_vIn124 +data T_Position_vOut124 = T_Position_vOut124 (Doc) +{-# NOINLINE sem_Position_Position #-} +sem_Position_Position :: (String) -> (Int) -> (Int) -> T_Position +sem_Position_Position arg_filename_ arg_line_ arg_column_ = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _text = rule253 arg_column_ arg_filename_ arg_line_ + _lhsOtext :: Doc + _lhsOtext = rule254 _text + __result_ = T_Position_vOut124 _lhsOtext + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule253 #-} + rule253 = \ column_ filename_ line_ -> + text filename_ <> tupled [int line_, int column_] + {-# INLINE rule254 #-} + rule254 = \ _text -> + _text +{-# NOINLINE sem_Position_Unknown #-} +sem_Position_Unknown :: T_Position +sem_Position_Unknown = T_Position (return st125) where + {-# NOINLINE st125 #-} + st125 = let + v124 :: T_Position_v124 + v124 = \ (T_Position_vIn124 ) -> ( let + _text = rule255 () + _lhsOtext :: Doc + _lhsOtext = rule256 _text + __result_ = T_Position_vOut124 _lhsOtext + in __result_ ) + in C_Position_s125 v124 + {-# INLINE rule255 #-} + rule255 = \ (_ :: ()) -> + text "Unknown" + {-# INLINE rule256 #-} + rule256 = \ _text -> + _text + +-- Qualifier --------------------------------------------------- +-- wrapper +data Inh_Qualifier = Inh_Qualifier { } +data Syn_Qualifier = Syn_Qualifier { text_Syn_Qualifier :: (Doc) } +{-# INLINABLE wrap_Qualifier #-} +wrap_Qualifier :: T_Qualifier -> Inh_Qualifier -> (Syn_Qualifier ) +wrap_Qualifier (T_Qualifier act) (Inh_Qualifier ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifier_vIn127 + (T_Qualifier_vOut127 _lhsOtext) <- return (inv_Qualifier_s128 sem arg) + return (Syn_Qualifier _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Qualifier #-} +sem_Qualifier :: Qualifier -> T_Qualifier +sem_Qualifier ( Qualifier_Guard range_ guard_ ) = sem_Qualifier_Guard ( sem_Range range_ ) ( sem_Expression guard_ ) +sem_Qualifier ( Qualifier_Let range_ declarations_ ) = sem_Qualifier_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Qualifier ( Qualifier_Generator range_ pattern_ expression_ ) = sem_Qualifier_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Qualifier ( Qualifier_Empty range_ ) = sem_Qualifier_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Qualifier = T_Qualifier { + attach_T_Qualifier :: Identity (T_Qualifier_s128 ) + } +newtype T_Qualifier_s128 = C_Qualifier_s128 { + inv_Qualifier_s128 :: (T_Qualifier_v127 ) + } +data T_Qualifier_s129 = C_Qualifier_s129 +type T_Qualifier_v127 = (T_Qualifier_vIn127 ) -> (T_Qualifier_vOut127 ) +data T_Qualifier_vIn127 = T_Qualifier_vIn127 +data T_Qualifier_vOut127 = T_Qualifier_vOut127 (Doc) +{-# NOINLINE sem_Qualifier_Guard #-} +sem_Qualifier_Guard :: T_Range -> T_Expression -> T_Qualifier +sem_Qualifier_Guard arg_range_ arg_guard_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_guard_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _guardItext) = inv_Expression_s41 _guardX41 (T_Expression_vIn40 ) + _text = rule257 _guardItext + _lhsOtext :: Doc + _lhsOtext = rule258 _text + __result_ = T_Qualifier_vOut127 _lhsOtext + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule257 #-} + rule257 = \ ((_guardItext) :: Doc) -> + _guardItext + {-# INLINE rule258 #-} + rule258 = \ _text -> + _text +{-# NOINLINE sem_Qualifier_Let #-} +sem_Qualifier_Let :: T_Range -> T_Declarations -> T_Qualifier +sem_Qualifier_Let arg_range_ arg_declarations_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsItext) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _text = rule259 _declarationsItext + _lhsOtext :: Doc + _lhsOtext = rule260 _text + __result_ = T_Qualifier_vOut127 _lhsOtext + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule259 #-} + rule259 = \ ((_declarationsItext) :: [ Doc ] ) -> + text "let" <$> (indent 4 $ vcat _declarationsItext) + {-# INLINE rule260 #-} + rule260 = \ _text -> + _text +{-# NOINLINE sem_Qualifier_Generator #-} +sem_Qualifier_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Qualifier +sem_Qualifier_Generator arg_range_ arg_pattern_ arg_expression_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternItext) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _text = rule261 _expressionItext _patternItext + _lhsOtext :: Doc + _lhsOtext = rule262 _text + __result_ = T_Qualifier_vOut127 _lhsOtext + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule261 #-} + rule261 = \ ((_expressionItext) :: Doc) ((_patternItext) :: Doc) -> + _patternItext <+> text "<-" <+> _expressionItext + {-# INLINE rule262 #-} + rule262 = \ _text -> + _text +{-# NOINLINE sem_Qualifier_Empty #-} +sem_Qualifier_Empty :: T_Range -> T_Qualifier +sem_Qualifier_Empty arg_range_ = T_Qualifier (return st128) where + {-# NOINLINE st128 #-} + st128 = let + v127 :: T_Qualifier_v127 + v127 = \ (T_Qualifier_vIn127 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule263 () + _lhsOtext :: Doc + _lhsOtext = rule264 _text + __result_ = T_Qualifier_vOut127 _lhsOtext + in __result_ ) + in C_Qualifier_s128 v127 + {-# INLINE rule263 #-} + rule263 = \ (_ :: ()) -> + empty + {-# INLINE rule264 #-} + rule264 = \ _text -> + _text + +-- Qualifiers -------------------------------------------------- +-- wrapper +data Inh_Qualifiers = Inh_Qualifiers { } +data Syn_Qualifiers = Syn_Qualifiers { text_Syn_Qualifiers :: ( [ Doc ] ) } +{-# INLINABLE wrap_Qualifiers #-} +wrap_Qualifiers :: T_Qualifiers -> Inh_Qualifiers -> (Syn_Qualifiers ) +wrap_Qualifiers (T_Qualifiers act) (Inh_Qualifiers ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Qualifiers_vIn130 + (T_Qualifiers_vOut130 _lhsOtext) <- return (inv_Qualifiers_s131 sem arg) + return (Syn_Qualifiers _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Qualifiers #-} +sem_Qualifiers :: Qualifiers -> T_Qualifiers +sem_Qualifiers list = Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list) + +-- semantic domain +newtype T_Qualifiers = T_Qualifiers { + attach_T_Qualifiers :: Identity (T_Qualifiers_s131 ) + } +newtype T_Qualifiers_s131 = C_Qualifiers_s131 { + inv_Qualifiers_s131 :: (T_Qualifiers_v130 ) + } +data T_Qualifiers_s132 = C_Qualifiers_s132 +type T_Qualifiers_v130 = (T_Qualifiers_vIn130 ) -> (T_Qualifiers_vOut130 ) +data T_Qualifiers_vIn130 = T_Qualifiers_vIn130 +data T_Qualifiers_vOut130 = T_Qualifiers_vOut130 ( [ Doc ] ) +{-# NOINLINE sem_Qualifiers_Cons #-} +sem_Qualifiers_Cons :: T_Qualifier -> T_Qualifiers -> T_Qualifiers +sem_Qualifiers_Cons arg_hd_ arg_tl_ = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 ) -> ( let + _hdX128 = Control.Monad.Identity.runIdentity (attach_T_Qualifier (arg_hd_)) + _tlX131 = Control.Monad.Identity.runIdentity (attach_T_Qualifiers (arg_tl_)) + (T_Qualifier_vOut127 _hdItext) = inv_Qualifier_s128 _hdX128 (T_Qualifier_vIn127 ) + (T_Qualifiers_vOut130 _tlItext) = inv_Qualifiers_s131 _tlX131 (T_Qualifiers_vIn130 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule265 _hdItext _tlItext + __result_ = T_Qualifiers_vOut130 _lhsOtext + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule265 #-} + rule265 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_Qualifiers_Nil #-} +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = T_Qualifiers (return st131) where + {-# NOINLINE st131 #-} + st131 = let + v130 :: T_Qualifiers_v130 + v130 = \ (T_Qualifiers_vIn130 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule266 () + __result_ = T_Qualifiers_vOut130 _lhsOtext + in __result_ ) + in C_Qualifiers_s131 v130 + {-# INLINE rule266 #-} + rule266 = \ (_ :: ()) -> + [] + +-- Range ------------------------------------------------------- +-- wrapper +data Inh_Range = Inh_Range { } +data Syn_Range = Syn_Range { text_Syn_Range :: (Doc) } +{-# INLINABLE wrap_Range #-} +wrap_Range :: T_Range -> Inh_Range -> (Syn_Range ) +wrap_Range (T_Range act) (Inh_Range ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Range_vIn133 + (T_Range_vOut133 _lhsOtext) <- return (inv_Range_s134 sem arg) + return (Syn_Range _lhsOtext) + ) + +-- cata +{-# INLINE sem_Range #-} +sem_Range :: Range -> T_Range +sem_Range ( Range_Range start_ stop_ ) = sem_Range_Range ( sem_Position start_ ) ( sem_Position stop_ ) + +-- semantic domain +newtype T_Range = T_Range { + attach_T_Range :: Identity (T_Range_s134 ) + } +newtype T_Range_s134 = C_Range_s134 { + inv_Range_s134 :: (T_Range_v133 ) + } +data T_Range_s135 = C_Range_s135 +type T_Range_v133 = (T_Range_vIn133 ) -> (T_Range_vOut133 ) +data T_Range_vIn133 = T_Range_vIn133 +data T_Range_vOut133 = T_Range_vOut133 (Doc) +{-# NOINLINE sem_Range_Range #-} +sem_Range_Range :: T_Position -> T_Position -> T_Range +sem_Range_Range arg_start_ arg_stop_ = T_Range (return st134) where + {-# NOINLINE st134 #-} + st134 = let + v133 :: T_Range_v133 + v133 = \ (T_Range_vIn133 ) -> ( let + _startX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_start_)) + _stopX125 = Control.Monad.Identity.runIdentity (attach_T_Position (arg_stop_)) + (T_Position_vOut124 _startItext) = inv_Position_s125 _startX125 (T_Position_vIn124 ) + (T_Position_vOut124 _stopItext) = inv_Position_s125 _stopX125 (T_Position_vIn124 ) + _text = rule267 _startItext _stopItext + _lhsOtext :: Doc + _lhsOtext = rule268 _text + __result_ = T_Range_vOut133 _lhsOtext + in __result_ ) + in C_Range_s134 v133 + {-# INLINE rule267 #-} + rule267 = \ ((_startItext) :: Doc) ((_stopItext) :: Doc) -> + text "{-" <+> _startItext <+> text ", " <+> _stopItext <+> text "-}" + {-# INLINE rule268 #-} + rule268 = \ _text -> + _text + +-- RecordExpressionBinding ------------------------------------- +-- wrapper +data Inh_RecordExpressionBinding = Inh_RecordExpressionBinding { } +data Syn_RecordExpressionBinding = Syn_RecordExpressionBinding { text_Syn_RecordExpressionBinding :: (Doc) } +{-# INLINABLE wrap_RecordExpressionBinding #-} +wrap_RecordExpressionBinding :: T_RecordExpressionBinding -> Inh_RecordExpressionBinding -> (Syn_RecordExpressionBinding ) +wrap_RecordExpressionBinding (T_RecordExpressionBinding act) (Inh_RecordExpressionBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBinding_vIn136 + (T_RecordExpressionBinding_vOut136 _lhsOtext) <- return (inv_RecordExpressionBinding_s137 sem arg) + return (Syn_RecordExpressionBinding _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBinding #-} +sem_RecordExpressionBinding :: RecordExpressionBinding -> T_RecordExpressionBinding +sem_RecordExpressionBinding ( RecordExpressionBinding_RecordExpressionBinding range_ name_ expression_ ) = sem_RecordExpressionBinding_RecordExpressionBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Expression expression_ ) + +-- semantic domain +newtype T_RecordExpressionBinding = T_RecordExpressionBinding { + attach_T_RecordExpressionBinding :: Identity (T_RecordExpressionBinding_s137 ) + } +newtype T_RecordExpressionBinding_s137 = C_RecordExpressionBinding_s137 { + inv_RecordExpressionBinding_s137 :: (T_RecordExpressionBinding_v136 ) + } +data T_RecordExpressionBinding_s138 = C_RecordExpressionBinding_s138 +type T_RecordExpressionBinding_v136 = (T_RecordExpressionBinding_vIn136 ) -> (T_RecordExpressionBinding_vOut136 ) +data T_RecordExpressionBinding_vIn136 = T_RecordExpressionBinding_vIn136 +data T_RecordExpressionBinding_vOut136 = T_RecordExpressionBinding_vOut136 (Doc) +{-# NOINLINE sem_RecordExpressionBinding_RecordExpressionBinding #-} +sem_RecordExpressionBinding_RecordExpressionBinding :: T_Range -> T_Name -> T_Expression -> T_RecordExpressionBinding +sem_RecordExpressionBinding_RecordExpressionBinding arg_range_ arg_name_ arg_expression_ = T_RecordExpressionBinding (return st137) where + {-# NOINLINE st137 #-} + st137 = let + v136 :: T_RecordExpressionBinding_v136 + v136 = \ (T_RecordExpressionBinding_vIn136 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _text = rule269 () + _lhsOtext :: Doc + _lhsOtext = rule270 _text + __result_ = T_RecordExpressionBinding_vOut136 _lhsOtext + in __result_ ) + in C_RecordExpressionBinding_s137 v136 + {-# INLINE rule269 #-} + rule269 = \ (_ :: ()) -> + text "{- !!! record expression binding -}" + {-# INLINE rule270 #-} + rule270 = \ _text -> + _text + +-- RecordExpressionBindings ------------------------------------ +-- wrapper +data Inh_RecordExpressionBindings = Inh_RecordExpressionBindings { } +data Syn_RecordExpressionBindings = Syn_RecordExpressionBindings { text_Syn_RecordExpressionBindings :: ( [ Doc ] ) } +{-# INLINABLE wrap_RecordExpressionBindings #-} +wrap_RecordExpressionBindings :: T_RecordExpressionBindings -> Inh_RecordExpressionBindings -> (Syn_RecordExpressionBindings ) +wrap_RecordExpressionBindings (T_RecordExpressionBindings act) (Inh_RecordExpressionBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordExpressionBindings_vIn139 + (T_RecordExpressionBindings_vOut139 _lhsOtext) <- return (inv_RecordExpressionBindings_s140 sem arg) + return (Syn_RecordExpressionBindings _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_RecordExpressionBindings #-} +sem_RecordExpressionBindings :: RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings list = Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list) + +-- semantic domain +newtype T_RecordExpressionBindings = T_RecordExpressionBindings { + attach_T_RecordExpressionBindings :: Identity (T_RecordExpressionBindings_s140 ) + } +newtype T_RecordExpressionBindings_s140 = C_RecordExpressionBindings_s140 { + inv_RecordExpressionBindings_s140 :: (T_RecordExpressionBindings_v139 ) + } +data T_RecordExpressionBindings_s141 = C_RecordExpressionBindings_s141 +type T_RecordExpressionBindings_v139 = (T_RecordExpressionBindings_vIn139 ) -> (T_RecordExpressionBindings_vOut139 ) +data T_RecordExpressionBindings_vIn139 = T_RecordExpressionBindings_vIn139 +data T_RecordExpressionBindings_vOut139 = T_RecordExpressionBindings_vOut139 ( [ Doc ] ) +{-# NOINLINE sem_RecordExpressionBindings_Cons #-} +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> T_RecordExpressionBindings -> T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons arg_hd_ arg_tl_ = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 ) -> ( let + _hdX137 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBinding (arg_hd_)) + _tlX140 = Control.Monad.Identity.runIdentity (attach_T_RecordExpressionBindings (arg_tl_)) + (T_RecordExpressionBinding_vOut136 _hdItext) = inv_RecordExpressionBinding_s137 _hdX137 (T_RecordExpressionBinding_vIn136 ) + (T_RecordExpressionBindings_vOut139 _tlItext) = inv_RecordExpressionBindings_s140 _tlX140 (T_RecordExpressionBindings_vIn139 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule271 _hdItext _tlItext + __result_ = T_RecordExpressionBindings_vOut139 _lhsOtext + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule271 #-} + rule271 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_RecordExpressionBindings_Nil #-} +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = T_RecordExpressionBindings (return st140) where + {-# NOINLINE st140 #-} + st140 = let + v139 :: T_RecordExpressionBindings_v139 + v139 = \ (T_RecordExpressionBindings_vIn139 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule272 () + __result_ = T_RecordExpressionBindings_vOut139 _lhsOtext + in __result_ ) + in C_RecordExpressionBindings_s140 v139 + {-# INLINE rule272 #-} + rule272 = \ (_ :: ()) -> + [] + +-- RecordPatternBinding ---------------------------------------- +-- wrapper +data Inh_RecordPatternBinding = Inh_RecordPatternBinding { } +data Syn_RecordPatternBinding = Syn_RecordPatternBinding { text_Syn_RecordPatternBinding :: (Doc) } +{-# INLINABLE wrap_RecordPatternBinding #-} +wrap_RecordPatternBinding :: T_RecordPatternBinding -> Inh_RecordPatternBinding -> (Syn_RecordPatternBinding ) +wrap_RecordPatternBinding (T_RecordPatternBinding act) (Inh_RecordPatternBinding ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBinding_vIn142 + (T_RecordPatternBinding_vOut142 _lhsOtext) <- return (inv_RecordPatternBinding_s143 sem arg) + return (Syn_RecordPatternBinding _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBinding #-} +sem_RecordPatternBinding :: RecordPatternBinding -> T_RecordPatternBinding +sem_RecordPatternBinding ( RecordPatternBinding_RecordPatternBinding range_ name_ pattern_ ) = sem_RecordPatternBinding_RecordPatternBinding ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Pattern pattern_ ) + +-- semantic domain +newtype T_RecordPatternBinding = T_RecordPatternBinding { + attach_T_RecordPatternBinding :: Identity (T_RecordPatternBinding_s143 ) + } +newtype T_RecordPatternBinding_s143 = C_RecordPatternBinding_s143 { + inv_RecordPatternBinding_s143 :: (T_RecordPatternBinding_v142 ) + } +data T_RecordPatternBinding_s144 = C_RecordPatternBinding_s144 +type T_RecordPatternBinding_v142 = (T_RecordPatternBinding_vIn142 ) -> (T_RecordPatternBinding_vOut142 ) +data T_RecordPatternBinding_vIn142 = T_RecordPatternBinding_vIn142 +data T_RecordPatternBinding_vOut142 = T_RecordPatternBinding_vOut142 (Doc) +{-# NOINLINE sem_RecordPatternBinding_RecordPatternBinding #-} +sem_RecordPatternBinding_RecordPatternBinding :: T_Range -> T_Name -> T_Pattern -> T_RecordPatternBinding +sem_RecordPatternBinding_RecordPatternBinding arg_range_ arg_name_ arg_pattern_ = T_RecordPatternBinding (return st143) where + {-# NOINLINE st143 #-} + st143 = let + v142 :: T_RecordPatternBinding_v142 + v142 = \ (T_RecordPatternBinding_vIn142 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Pattern_vOut118 _patternItext) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + _text = rule273 () + _lhsOtext :: Doc + _lhsOtext = rule274 _text + __result_ = T_RecordPatternBinding_vOut142 _lhsOtext + in __result_ ) + in C_RecordPatternBinding_s143 v142 + {-# INLINE rule273 #-} + rule273 = \ (_ :: ()) -> + text "{- !!! record pattern binding -}" + {-# INLINE rule274 #-} + rule274 = \ _text -> + _text + +-- RecordPatternBindings --------------------------------------- +-- wrapper +data Inh_RecordPatternBindings = Inh_RecordPatternBindings { } +data Syn_RecordPatternBindings = Syn_RecordPatternBindings { text_Syn_RecordPatternBindings :: ( [ Doc ] ) } +{-# INLINABLE wrap_RecordPatternBindings #-} +wrap_RecordPatternBindings :: T_RecordPatternBindings -> Inh_RecordPatternBindings -> (Syn_RecordPatternBindings ) +wrap_RecordPatternBindings (T_RecordPatternBindings act) (Inh_RecordPatternBindings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RecordPatternBindings_vIn145 + (T_RecordPatternBindings_vOut145 _lhsOtext) <- return (inv_RecordPatternBindings_s146 sem arg) + return (Syn_RecordPatternBindings _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_RecordPatternBindings #-} +sem_RecordPatternBindings :: RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings list = Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list) + +-- semantic domain +newtype T_RecordPatternBindings = T_RecordPatternBindings { + attach_T_RecordPatternBindings :: Identity (T_RecordPatternBindings_s146 ) + } +newtype T_RecordPatternBindings_s146 = C_RecordPatternBindings_s146 { + inv_RecordPatternBindings_s146 :: (T_RecordPatternBindings_v145 ) + } +data T_RecordPatternBindings_s147 = C_RecordPatternBindings_s147 +type T_RecordPatternBindings_v145 = (T_RecordPatternBindings_vIn145 ) -> (T_RecordPatternBindings_vOut145 ) +data T_RecordPatternBindings_vIn145 = T_RecordPatternBindings_vIn145 +data T_RecordPatternBindings_vOut145 = T_RecordPatternBindings_vOut145 ( [ Doc ] ) +{-# NOINLINE sem_RecordPatternBindings_Cons #-} +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> T_RecordPatternBindings -> T_RecordPatternBindings +sem_RecordPatternBindings_Cons arg_hd_ arg_tl_ = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 ) -> ( let + _hdX143 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBinding (arg_hd_)) + _tlX146 = Control.Monad.Identity.runIdentity (attach_T_RecordPatternBindings (arg_tl_)) + (T_RecordPatternBinding_vOut142 _hdItext) = inv_RecordPatternBinding_s143 _hdX143 (T_RecordPatternBinding_vIn142 ) + (T_RecordPatternBindings_vOut145 _tlItext) = inv_RecordPatternBindings_s146 _tlX146 (T_RecordPatternBindings_vIn145 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule275 _hdItext _tlItext + __result_ = T_RecordPatternBindings_vOut145 _lhsOtext + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule275 #-} + rule275 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_RecordPatternBindings_Nil #-} +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = T_RecordPatternBindings (return st146) where + {-# NOINLINE st146 #-} + st146 = let + v145 :: T_RecordPatternBindings_v145 + v145 = \ (T_RecordPatternBindings_vIn145 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule276 () + __result_ = T_RecordPatternBindings_vOut145 _lhsOtext + in __result_ ) + in C_RecordPatternBindings_s146 v145 + {-# INLINE rule276 #-} + rule276 = \ (_ :: ()) -> + [] + +-- RightHandSide ----------------------------------------------- +-- wrapper +data Inh_RightHandSide = Inh_RightHandSide { } +data Syn_RightHandSide = Syn_RightHandSide { text_Syn_RightHandSide :: ( Doc -> Doc ) } +{-# INLINABLE wrap_RightHandSide #-} +wrap_RightHandSide :: T_RightHandSide -> Inh_RightHandSide -> (Syn_RightHandSide ) +wrap_RightHandSide (T_RightHandSide act) (Inh_RightHandSide ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_RightHandSide_vIn148 + (T_RightHandSide_vOut148 _lhsOtext) <- return (inv_RightHandSide_s149 sem arg) + return (Syn_RightHandSide _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_RightHandSide #-} +sem_RightHandSide :: RightHandSide -> T_RightHandSide +sem_RightHandSide ( RightHandSide_Expression range_ expression_ where_ ) = sem_RightHandSide_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) ( sem_MaybeDeclarations where_ ) +sem_RightHandSide ( RightHandSide_Guarded range_ guardedexpressions_ where_ ) = sem_RightHandSide_Guarded ( sem_Range range_ ) ( sem_GuardedExpressions guardedexpressions_ ) ( sem_MaybeDeclarations where_ ) + +-- semantic domain +newtype T_RightHandSide = T_RightHandSide { + attach_T_RightHandSide :: Identity (T_RightHandSide_s149 ) + } +newtype T_RightHandSide_s149 = C_RightHandSide_s149 { + inv_RightHandSide_s149 :: (T_RightHandSide_v148 ) + } +data T_RightHandSide_s150 = C_RightHandSide_s150 +type T_RightHandSide_v148 = (T_RightHandSide_vIn148 ) -> (T_RightHandSide_vOut148 ) +data T_RightHandSide_vIn148 = T_RightHandSide_vIn148 +data T_RightHandSide_vOut148 = T_RightHandSide_vOut148 ( Doc -> Doc ) +{-# NOINLINE sem_RightHandSide_Expression #-} +sem_RightHandSide_Expression :: T_Range -> T_Expression -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Expression arg_range_ arg_expression_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + (T_MaybeDeclarations_vOut88 _whereItext) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _text = rule277 _justText + _justText = rule278 _expressionItext _whereItext + _lhsOtext :: Doc -> Doc + _lhsOtext = rule279 _text + __result_ = T_RightHandSide_vOut148 _lhsOtext + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule277 #-} + rule277 = \ _justText -> + \assign -> assign <$> _justText + {-# INLINE rule278 #-} + rule278 = \ ((_expressionItext) :: Doc) ((_whereItext) :: Maybe [ Doc ] ) -> + indent 4 + ( _expressionItext + <> maybe + empty + (\ds -> PPrint.empty <$> text "where" <$> indent 4 (vcat ds)) + _whereItext + ) + {-# INLINE rule279 #-} + rule279 = \ _text -> + _text +{-# NOINLINE sem_RightHandSide_Guarded #-} +sem_RightHandSide_Guarded :: T_Range -> T_GuardedExpressions -> T_MaybeDeclarations -> T_RightHandSide +sem_RightHandSide_Guarded arg_range_ arg_guardedexpressions_ arg_where_ = T_RightHandSide (return st149) where + {-# NOINLINE st149 #-} + st149 = let + v148 :: T_RightHandSide_v148 + v148 = \ (T_RightHandSide_vIn148 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _guardedexpressionsX65 = Control.Monad.Identity.runIdentity (attach_T_GuardedExpressions (arg_guardedexpressions_)) + _whereX89 = Control.Monad.Identity.runIdentity (attach_T_MaybeDeclarations (arg_where_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_GuardedExpressions_vOut64 _guardedexpressionsItext) = inv_GuardedExpressions_s65 _guardedexpressionsX65 (T_GuardedExpressions_vIn64 ) + (T_MaybeDeclarations_vOut88 _whereItext) = inv_MaybeDeclarations_s89 _whereX89 (T_MaybeDeclarations_vIn88 ) + _text = rule280 _guardedexpressionsItext _whereItext + _lhsOtext :: Doc -> Doc + _lhsOtext = rule281 _text + __result_ = T_RightHandSide_vOut148 _lhsOtext + in __result_ ) + in C_RightHandSide_s149 v148 + {-# INLINE rule280 #-} + rule280 = \ ((_guardedexpressionsItext) :: [ Doc -> Doc ] ) ((_whereItext) :: Maybe [ Doc ] ) -> + \assign -> + ( PPrint.empty + <$> vsep + (zipWith (\f x -> indent 4 (f x)) _guardedexpressionsItext (repeat assign)) + <> maybe + empty + (\ds -> PPrint.empty <$> indent 4 (text "where" <$> indent 4 (vcat ds))) + _whereItext + ) + {-# INLINE rule281 #-} + rule281 = \ _text -> + _text + +-- SimpleType -------------------------------------------------- +-- wrapper +data Inh_SimpleType = Inh_SimpleType { } +data Syn_SimpleType = Syn_SimpleType { text_Syn_SimpleType :: (Doc) } +{-# INLINABLE wrap_SimpleType #-} +wrap_SimpleType :: T_SimpleType -> Inh_SimpleType -> (Syn_SimpleType ) +wrap_SimpleType (T_SimpleType act) (Inh_SimpleType ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_SimpleType_vIn151 + (T_SimpleType_vOut151 _lhsOtext) <- return (inv_SimpleType_s152 sem arg) + return (Syn_SimpleType _lhsOtext) + ) + +-- cata +{-# INLINE sem_SimpleType #-} +sem_SimpleType :: SimpleType -> T_SimpleType +sem_SimpleType ( SimpleType_SimpleType range_ name_ typevariables_ ) = sem_SimpleType_SimpleType ( sem_Range range_ ) ( sem_Name name_ ) ( sem_Names typevariables_ ) + +-- semantic domain +newtype T_SimpleType = T_SimpleType { + attach_T_SimpleType :: Identity (T_SimpleType_s152 ) + } +newtype T_SimpleType_s152 = C_SimpleType_s152 { + inv_SimpleType_s152 :: (T_SimpleType_v151 ) + } +data T_SimpleType_s153 = C_SimpleType_s153 +type T_SimpleType_v151 = (T_SimpleType_vIn151 ) -> (T_SimpleType_vOut151 ) +data T_SimpleType_vIn151 = T_SimpleType_vIn151 +data T_SimpleType_vOut151 = T_SimpleType_vOut151 (Doc) +{-# NOINLINE sem_SimpleType_SimpleType #-} +sem_SimpleType_SimpleType :: T_Range -> T_Name -> T_Names -> T_SimpleType +sem_SimpleType_SimpleType arg_range_ arg_name_ arg_typevariables_ = T_SimpleType (return st152) where + {-# NOINLINE st152 #-} + st152 = let + v151 :: T_SimpleType_v151 + v151 = \ (T_SimpleType_vIn151 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + (T_Names_vOut115 _typevariablesIisIdentifier _typevariablesIisOperator _typevariablesIisSpecial _typevariablesItext) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + _text = rule282 _nameItext _typevariablesItext + _lhsOtext :: Doc + _lhsOtext = rule283 _text + __result_ = T_SimpleType_vOut151 _lhsOtext + in __result_ ) + in C_SimpleType_s152 v151 + {-# INLINE rule282 #-} + rule282 = \ ((_nameItext) :: Doc) ((_typevariablesItext) :: [ Doc ] ) -> + foldl (<+>) _nameItext _typevariablesItext + {-# INLINE rule283 #-} + rule283 = \ _text -> + _text + +-- Statement --------------------------------------------------- +-- wrapper +data Inh_Statement = Inh_Statement { } +data Syn_Statement = Syn_Statement { text_Syn_Statement :: (Doc) } +{-# INLINABLE wrap_Statement #-} +wrap_Statement :: T_Statement -> Inh_Statement -> (Syn_Statement ) +wrap_Statement (T_Statement act) (Inh_Statement ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statement_vIn154 + (T_Statement_vOut154 _lhsOtext) <- return (inv_Statement_s155 sem arg) + return (Syn_Statement _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Statement #-} +sem_Statement :: Statement -> T_Statement +sem_Statement ( Statement_Expression range_ expression_ ) = sem_Statement_Expression ( sem_Range range_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Let range_ declarations_ ) = sem_Statement_Let ( sem_Range range_ ) ( sem_Declarations declarations_ ) +sem_Statement ( Statement_Generator range_ pattern_ expression_ ) = sem_Statement_Generator ( sem_Range range_ ) ( sem_Pattern pattern_ ) ( sem_Expression expression_ ) +sem_Statement ( Statement_Empty range_ ) = sem_Statement_Empty ( sem_Range range_ ) + +-- semantic domain +newtype T_Statement = T_Statement { + attach_T_Statement :: Identity (T_Statement_s155 ) + } +newtype T_Statement_s155 = C_Statement_s155 { + inv_Statement_s155 :: (T_Statement_v154 ) + } +data T_Statement_s156 = C_Statement_s156 +type T_Statement_v154 = (T_Statement_vIn154 ) -> (T_Statement_vOut154 ) +data T_Statement_vIn154 = T_Statement_vIn154 +data T_Statement_vOut154 = T_Statement_vOut154 (Doc) +{-# NOINLINE sem_Statement_Expression #-} +sem_Statement_Expression :: T_Range -> T_Expression -> T_Statement +sem_Statement_Expression arg_range_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _text = rule284 _expressionItext + _lhsOtext :: Doc + _lhsOtext = rule285 _text + __result_ = T_Statement_vOut154 _lhsOtext + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule284 #-} + rule284 = \ ((_expressionItext) :: Doc) -> + _expressionItext + {-# INLINE rule285 #-} + rule285 = \ _text -> + _text +{-# NOINLINE sem_Statement_Let #-} +sem_Statement_Let :: T_Range -> T_Declarations -> T_Statement +sem_Statement_Let arg_range_ arg_declarations_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _declarationsX32 = Control.Monad.Identity.runIdentity (attach_T_Declarations (arg_declarations_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Declarations_vOut31 _declarationsItext) = inv_Declarations_s32 _declarationsX32 (T_Declarations_vIn31 ) + _text = rule286 _declarationsItext + _lhsOtext :: Doc + _lhsOtext = rule287 _text + __result_ = T_Statement_vOut154 _lhsOtext + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule286 #-} + rule286 = \ ((_declarationsItext) :: [ Doc ] ) -> + text "let" <$> (indent 4 $ vcat _declarationsItext) + {-# INLINE rule287 #-} + rule287 = \ _text -> + _text +{-# NOINLINE sem_Statement_Generator #-} +sem_Statement_Generator :: T_Range -> T_Pattern -> T_Expression -> T_Statement +sem_Statement_Generator arg_range_ arg_pattern_ arg_expression_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _patternX119 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) + _expressionX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_expression_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Pattern_vOut118 _patternItext) = inv_Pattern_s119 _patternX119 (T_Pattern_vIn118 ) + (T_Expression_vOut40 _expressionItext) = inv_Expression_s41 _expressionX41 (T_Expression_vIn40 ) + _text = rule288 _expressionItext _patternItext + _lhsOtext :: Doc + _lhsOtext = rule289 _text + __result_ = T_Statement_vOut154 _lhsOtext + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule288 #-} + rule288 = \ ((_expressionItext) :: Doc) ((_patternItext) :: Doc) -> + _patternItext <+> text "<-" <+> _expressionItext + {-# INLINE rule289 #-} + rule289 = \ _text -> + _text +{-# NOINLINE sem_Statement_Empty #-} +sem_Statement_Empty :: T_Range -> T_Statement +sem_Statement_Empty arg_range_ = T_Statement (return st155) where + {-# NOINLINE st155 #-} + st155 = let + v154 :: T_Statement_v154 + v154 = \ (T_Statement_vIn154 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + _text = rule290 () + _lhsOtext :: Doc + _lhsOtext = rule291 _text + __result_ = T_Statement_vOut154 _lhsOtext + in __result_ ) + in C_Statement_s155 v154 + {-# INLINE rule290 #-} + rule290 = \ (_ :: ()) -> + empty + {-# INLINE rule291 #-} + rule291 = \ _text -> + _text + +-- Statements -------------------------------------------------- +-- wrapper +data Inh_Statements = Inh_Statements { } +data Syn_Statements = Syn_Statements { text_Syn_Statements :: ( [ Doc ] ) } +{-# INLINABLE wrap_Statements #-} +wrap_Statements :: T_Statements -> Inh_Statements -> (Syn_Statements ) +wrap_Statements (T_Statements act) (Inh_Statements ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Statements_vIn157 + (T_Statements_vOut157 _lhsOtext) <- return (inv_Statements_s158 sem arg) + return (Syn_Statements _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Statements #-} +sem_Statements :: Statements -> T_Statements +sem_Statements list = Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list) + +-- semantic domain +newtype T_Statements = T_Statements { + attach_T_Statements :: Identity (T_Statements_s158 ) + } +newtype T_Statements_s158 = C_Statements_s158 { + inv_Statements_s158 :: (T_Statements_v157 ) + } +data T_Statements_s159 = C_Statements_s159 +type T_Statements_v157 = (T_Statements_vIn157 ) -> (T_Statements_vOut157 ) +data T_Statements_vIn157 = T_Statements_vIn157 +data T_Statements_vOut157 = T_Statements_vOut157 ( [ Doc ] ) +{-# NOINLINE sem_Statements_Cons #-} +sem_Statements_Cons :: T_Statement -> T_Statements -> T_Statements +sem_Statements_Cons arg_hd_ arg_tl_ = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 ) -> ( let + _hdX155 = Control.Monad.Identity.runIdentity (attach_T_Statement (arg_hd_)) + _tlX158 = Control.Monad.Identity.runIdentity (attach_T_Statements (arg_tl_)) + (T_Statement_vOut154 _hdItext) = inv_Statement_s155 _hdX155 (T_Statement_vIn154 ) + (T_Statements_vOut157 _tlItext) = inv_Statements_s158 _tlX158 (T_Statements_vIn157 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule292 _hdItext _tlItext + __result_ = T_Statements_vOut157 _lhsOtext + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule292 #-} + rule292 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_Statements_Nil #-} +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = T_Statements (return st158) where + {-# NOINLINE st158 #-} + st158 = let + v157 :: T_Statements_v157 + v157 = \ (T_Statements_vIn157 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule293 () + __result_ = T_Statements_vOut157 _lhsOtext + in __result_ ) + in C_Statements_s158 v157 + {-# INLINE rule293 #-} + rule293 = \ (_ :: ()) -> + [] + +-- Strings ----------------------------------------------------- +-- wrapper +data Inh_Strings = Inh_Strings { } +data Syn_Strings = Syn_Strings { text_Syn_Strings :: ( [ Doc ] ) } +{-# INLINABLE wrap_Strings #-} +wrap_Strings :: T_Strings -> Inh_Strings -> (Syn_Strings ) +wrap_Strings (T_Strings act) (Inh_Strings ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Strings_vIn160 + (T_Strings_vOut160 _lhsOtext) <- return (inv_Strings_s161 sem arg) + return (Syn_Strings _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Strings #-} +sem_Strings :: Strings -> T_Strings +sem_Strings list = Prelude.foldr sem_Strings_Cons sem_Strings_Nil list + +-- semantic domain +newtype T_Strings = T_Strings { + attach_T_Strings :: Identity (T_Strings_s161 ) + } +newtype T_Strings_s161 = C_Strings_s161 { + inv_Strings_s161 :: (T_Strings_v160 ) + } +data T_Strings_s162 = C_Strings_s162 +type T_Strings_v160 = (T_Strings_vIn160 ) -> (T_Strings_vOut160 ) +data T_Strings_vIn160 = T_Strings_vIn160 +data T_Strings_vOut160 = T_Strings_vOut160 ( [ Doc ] ) +{-# NOINLINE sem_Strings_Cons #-} +sem_Strings_Cons :: (String) -> T_Strings -> T_Strings +sem_Strings_Cons _ arg_tl_ = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _tlX161 = Control.Monad.Identity.runIdentity (attach_T_Strings (arg_tl_)) + (T_Strings_vOut160 _tlItext) = inv_Strings_s161 _tlX161 (T_Strings_vIn160 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule294 _tlItext + __result_ = T_Strings_vOut160 _lhsOtext + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule294 #-} + rule294 = \ ((_tlItext) :: [ Doc ] ) -> + _tlItext +{-# NOINLINE sem_Strings_Nil #-} +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = T_Strings (return st161) where + {-# NOINLINE st161 #-} + st161 = let + v160 :: T_Strings_v160 + v160 = \ (T_Strings_vIn160 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule295 () + __result_ = T_Strings_vOut160 _lhsOtext + in __result_ ) + in C_Strings_s161 v160 + {-# INLINE rule295 #-} + rule295 = \ (_ :: ()) -> + [] + +-- Type -------------------------------------------------------- +-- wrapper +data Inh_Type = Inh_Type { } +data Syn_Type = Syn_Type { text_Syn_Type :: (Doc) } +{-# INLINABLE wrap_Type #-} +wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) +wrap_Type (T_Type act) (Inh_Type ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Type_vIn163 + (T_Type_vOut163 _lhsOtext) <- return (inv_Type_s164 sem arg) + return (Syn_Type _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Type #-} +sem_Type :: Type -> T_Type +sem_Type ( Type_Application range_ prefix_ function_ arguments_ ) = sem_Type_Application ( sem_Range range_ ) prefix_ ( sem_Type function_ ) ( sem_Types arguments_ ) +sem_Type ( Type_Variable range_ name_ ) = sem_Type_Variable ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Constructor range_ name_ ) = sem_Type_Constructor ( sem_Range range_ ) ( sem_Name name_ ) +sem_Type ( Type_Qualified range_ context_ type_ ) = sem_Type_Qualified ( sem_Range range_ ) ( sem_ContextItems context_ ) ( sem_Type type_ ) +sem_Type ( Type_Forall range_ typevariables_ type_ ) = sem_Type_Forall ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Exists range_ typevariables_ type_ ) = sem_Type_Exists ( sem_Range range_ ) ( sem_Names typevariables_ ) ( sem_Type type_ ) +sem_Type ( Type_Parenthesized range_ type_ ) = sem_Type_Parenthesized ( sem_Range range_ ) ( sem_Type type_ ) + +-- semantic domain +newtype T_Type = T_Type { + attach_T_Type :: Identity (T_Type_s164 ) + } +newtype T_Type_s164 = C_Type_s164 { + inv_Type_s164 :: (T_Type_v163 ) + } +data T_Type_s165 = C_Type_s165 +type T_Type_v163 = (T_Type_vIn163 ) -> (T_Type_vOut163 ) +data T_Type_vIn163 = T_Type_vIn163 +data T_Type_vOut163 = T_Type_vOut163 (Doc) +{-# NOINLINE sem_Type_Application #-} +sem_Type_Application :: T_Range -> (Bool) -> T_Type -> T_Types -> T_Type +sem_Type_Application arg_range_ arg_prefix_ arg_function_ arg_arguments_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _functionX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_function_)) + _argumentsX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_arguments_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _functionItext) = inv_Type_s164 _functionX164 (T_Type_vIn163 ) + (T_Types_vOut166 _argumentsItext) = inv_Types_s167 _argumentsX167 (T_Types_vIn166 ) + _text = rule296 _argumentsItext _functionItext arg_prefix_ + _lhsOtext :: Doc + _lhsOtext = rule297 _text + __result_ = T_Type_vOut163 _lhsOtext + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule296 #-} + rule296 = \ ((_argumentsItext) :: [ Doc ] ) ((_functionItext) :: Doc) prefix_ -> + if prefix_ then + foldl (<+>) _functionItext _argumentsItext + else if show _functionItext == "[]" then + PPrint.list _argumentsItext + else if isTupleConstructor (show _functionItext) then + tupled _argumentsItext + else + case _argumentsItext of + [a, b] -> a <+> _functionItext <+> b + _ -> text "{- error: Unknown special application notation -}" + {-# INLINE rule297 #-} + rule297 = \ _text -> + _text +{-# NOINLINE sem_Type_Variable #-} +sem_Type_Variable :: T_Range -> T_Name -> T_Type +sem_Type_Variable arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _text = rule298 _nameItext + _lhsOtext :: Doc + _lhsOtext = rule299 _text + __result_ = T_Type_vOut163 _lhsOtext + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule298 #-} + rule298 = \ ((_nameItext) :: Doc) -> + _nameItext + {-# INLINE rule299 #-} + rule299 = \ _text -> + _text +{-# NOINLINE sem_Type_Constructor #-} +sem_Type_Constructor :: T_Range -> T_Name -> T_Type +sem_Type_Constructor arg_range_ arg_name_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _nameX113 = Control.Monad.Identity.runIdentity (attach_T_Name (arg_name_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Name_vOut112 _nameIisIdentifier _nameIisOperator _nameIisSpecial _nameItext) = inv_Name_s113 _nameX113 (T_Name_vIn112 ) + _text = rule300 _nameItext + _lhsOtext :: Doc + _lhsOtext = rule301 _text + __result_ = T_Type_vOut163 _lhsOtext + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule300 #-} + rule300 = \ ((_nameItext) :: Doc) -> + _nameItext + {-# INLINE rule301 #-} + rule301 = \ _text -> + _text +{-# NOINLINE sem_Type_Qualified #-} +sem_Type_Qualified :: T_Range -> T_ContextItems -> T_Type -> T_Type +sem_Type_Qualified arg_range_ arg_context_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _contextX26 = Control.Monad.Identity.runIdentity (attach_T_ContextItems (arg_context_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_ContextItems_vOut25 _contextItext) = inv_ContextItems_s26 _contextX26 (T_ContextItems_vIn25 ) + (T_Type_vOut163 _typeItext) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _text = rule302 _contextItext _typeItext + _lhsOtext :: Doc + _lhsOtext = rule303 _text + __result_ = T_Type_vOut163 _lhsOtext + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule302 #-} + rule302 = \ ((_contextItext) :: [ Doc ] ) ((_typeItext) :: Doc) -> + case _contextItext of + [ct] -> ct <+> text "=>" <+> _typeItext + cts -> parens (commas cts) <+> text "=>" <+> _typeItext + {-# INLINE rule303 #-} + rule303 = \ _text -> + _text +{-# NOINLINE sem_Type_Forall #-} +sem_Type_Forall :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Forall arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIisIdentifier _typevariablesIisOperator _typevariablesIisSpecial _typevariablesItext) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeItext) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _text = rule304 _typeItext _typevariablesItext + _lhsOtext :: Doc + _lhsOtext = rule305 _text + __result_ = T_Type_vOut163 _lhsOtext + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule304 #-} + rule304 = \ ((_typeItext) :: Doc) ((_typevariablesItext) :: [ Doc ] ) -> + foldl (<+>) (text "forall") _typevariablesItext <> text "." <> _typeItext + {-# INLINE rule305 #-} + rule305 = \ _text -> + _text +{-# NOINLINE sem_Type_Exists #-} +sem_Type_Exists :: T_Range -> T_Names -> T_Type -> T_Type +sem_Type_Exists arg_range_ arg_typevariables_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typevariablesX116 = Control.Monad.Identity.runIdentity (attach_T_Names (arg_typevariables_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Names_vOut115 _typevariablesIisIdentifier _typevariablesIisOperator _typevariablesIisSpecial _typevariablesItext) = inv_Names_s116 _typevariablesX116 (T_Names_vIn115 ) + (T_Type_vOut163 _typeItext) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _text = rule306 _typeItext _typevariablesItext + _lhsOtext :: Doc + _lhsOtext = rule307 _text + __result_ = T_Type_vOut163 _lhsOtext + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule306 #-} + rule306 = \ ((_typeItext) :: Doc) ((_typevariablesItext) :: [ Doc ] ) -> + foldl (<+>) (text "exists") _typevariablesItext <> text "." <> _typeItext + {-# INLINE rule307 #-} + rule307 = \ _text -> + _text +{-# NOINLINE sem_Type_Parenthesized #-} +sem_Type_Parenthesized :: T_Range -> T_Type -> T_Type +sem_Type_Parenthesized arg_range_ arg_type_ = T_Type (return st164) where + {-# NOINLINE st164 #-} + st164 = let + v163 :: T_Type_v163 + v163 = \ (T_Type_vIn163 ) -> ( let + _rangeX134 = Control.Monad.Identity.runIdentity (attach_T_Range (arg_range_)) + _typeX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_type_)) + (T_Range_vOut133 _rangeItext) = inv_Range_s134 _rangeX134 (T_Range_vIn133 ) + (T_Type_vOut163 _typeItext) = inv_Type_s164 _typeX164 (T_Type_vIn163 ) + _text = rule308 _typeItext + _lhsOtext :: Doc + _lhsOtext = rule309 _text + __result_ = T_Type_vOut163 _lhsOtext + in __result_ ) + in C_Type_s164 v163 + {-# INLINE rule308 #-} + rule308 = \ ((_typeItext) :: Doc) -> + parens _typeItext + {-# INLINE rule309 #-} + rule309 = \ _text -> + _text + +-- Types ------------------------------------------------------- +-- wrapper +data Inh_Types = Inh_Types { } +data Syn_Types = Syn_Types { text_Syn_Types :: ( [ Doc ] ) } +{-# INLINABLE wrap_Types #-} +wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) +wrap_Types (T_Types act) (Inh_Types ) = + Control.Monad.Identity.runIdentity ( + do sem <- act + let arg = T_Types_vIn166 + (T_Types_vOut166 _lhsOtext) <- return (inv_Types_s167 sem arg) + return (Syn_Types _lhsOtext) + ) + +-- cata +{-# NOINLINE sem_Types #-} +sem_Types :: Types -> T_Types +sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) + +-- semantic domain +newtype T_Types = T_Types { + attach_T_Types :: Identity (T_Types_s167 ) + } +newtype T_Types_s167 = C_Types_s167 { + inv_Types_s167 :: (T_Types_v166 ) + } +data T_Types_s168 = C_Types_s168 +type T_Types_v166 = (T_Types_vIn166 ) -> (T_Types_vOut166 ) +data T_Types_vIn166 = T_Types_vIn166 +data T_Types_vOut166 = T_Types_vOut166 ( [ Doc ] ) +{-# NOINLINE sem_Types_Cons #-} +sem_Types_Cons :: T_Type -> T_Types -> T_Types +sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _hdX164 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) + _tlX167 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) + (T_Type_vOut163 _hdItext) = inv_Type_s164 _hdX164 (T_Type_vIn163 ) + (T_Types_vOut166 _tlItext) = inv_Types_s167 _tlX167 (T_Types_vIn166 ) + _lhsOtext :: [ Doc ] + _lhsOtext = rule310 _hdItext _tlItext + __result_ = T_Types_vOut166 _lhsOtext + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule310 #-} + rule310 = \ ((_hdItext) :: Doc) ((_tlItext) :: [ Doc ] ) -> + _hdItext : _tlItext +{-# NOINLINE sem_Types_Nil #-} +sem_Types_Nil :: T_Types +sem_Types_Nil = T_Types (return st167) where + {-# NOINLINE st167 #-} + st167 = let + v166 :: T_Types_v166 + v166 = \ (T_Types_vIn166 ) -> ( let + _lhsOtext :: [ Doc ] + _lhsOtext = rule311 () + __result_ = T_Types_vOut166 _lhsOtext + in __result_ ) + in C_Types_s167 v166 + {-# INLINE rule311 #-} + rule311 = \ (_ :: ()) -> + [] diff --git a/src/Helium/Syntax/UHA_Range.hs b/src/Helium/Syntax/UHA_Range.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Syntax/UHA_Range.hs @@ -0,0 +1,291 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| Module : UHA_Range + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Syntax.UHA_Range where + +import Helium.Syntax.UHA_Syntax +import Lvm.Common.Id(Id, stringFromId) +import Helium.Utils.Utils(internalError) +import Data.Maybe(isJust) +import Data.List(sort, partition) + +-------------------------------------------------------------- +-- instances for Range and Position + +instance Show Range where + show = showRange + +instance Eq Range where + Range_Range start1 stop1 == Range_Range start2 stop2 = + start1 == start2 && stop1 == stop2 + +instance Ord Range where + Range_Range start1 stop1 <= Range_Range start2 stop2 = + (start1 < start2) + || + (start1 == start2 && stop1 <= stop2) + +instance Eq Position where + Position_Position m1 l1 c1 == Position_Position m2 l2 c2 = + m1 == m2 && l1 == l2 && c1 == c2 + Position_Unknown == Position_Unknown = True + Position_Unknown == Position_Position{} = False + Position_Position{} == Position_Unknown = False + +instance Ord Position where + Position_Position _ l1 c1 <= Position_Position _ l2 c2 = + (l1 < l2) + || + (l1 == l2 && c1 <= c2) + Position_Unknown <= Position_Unknown = True + Position_Unknown <= Position_Position _ _ _ = True + Position_Position _ _ _ <= Position_Unknown = False + +-------------------------------------------------------------- + +getNameRange :: Name -> Range -- !!!Name +getNameRange (Name_Identifier r _ _) = r +getNameRange (Name_Operator r _ _) = r +getNameRange (Name_Special r _ _) = r + +setNameRange :: Name -> Range -> Name -- !!!Name +setNameRange (Name_Identifier _ s e) r = Name_Identifier r s e +setNameRange (Name_Operator _ s e) r = Name_Operator r s e +setNameRange (Name_Special _ s e) r = Name_Special r s e + +rangeFromImportDeclaration :: ImportDeclaration -> Range +rangeFromImportDeclaration importDecl = + case importDecl of + ImportDeclaration_Import r _ _ _ _ -> r + ImportDeclaration_Empty r -> r + +mergeRanges :: Range -> Range -> Range +mergeRanges + (Range_Range + (Position_Position startF1 startL1 startC1) + (Position_Position stopF1 stopL1 stopC1 ) + ) + (Range_Range + (Position_Position startF2 startL2 startC2) + (Position_Position stopF2 stopL2 stopC2 ) + ) + | startF1 == stopF1 && startF2 == stopF2 && startF1 == startF2 = + let + (startL, startC, stopL, stopC) = + if startL1 < startL2 || (startL1 == startL2 && startC1 <= startC2) then + (startL1, startC1, stopL2, stopC2) + else + (startL2, startC2, stopL1, stopC1) + in + Range_Range + (Position_Position startF1 startL startC) + (Position_Position startF1 stopL stopC ) +mergeRanges _ _ = Range_Range Position_Unknown Position_Unknown + +-- In UHA there is no room for the position of built-in constructs +noRange :: Range +noRange = Range_Range Position_Unknown Position_Unknown + +emptyRange :: Range +emptyRange = let p = Position_Position "" 1 1 in Range_Range p p +----------------------------------------------------- +-- Misuse the second position of the range to +-- store where the name was imported from. +makeImportRange :: Id -> Id -> Range +makeImportRange importedInId importedFromId = + Range_Range + (Position_Position (stringFromId importedInId ) 0 0) + (Position_Position (stringFromId importedFromId) 0 0) + +isImportRange :: Range -> Bool +isImportRange = isJust . modulesFromImportRange + +isImportName :: Name -> Bool +isImportName = isImportRange.getNameRange + +modulesFromImportRange :: Range -> Maybe (String, String) +modulesFromImportRange + (Range_Range + (Position_Position importedIn 0 0) + (Position_Position importedFrom 0 0) + ) = + Just (importedIn, importedFrom) +modulesFromImportRange _ = Nothing +-- End of misuse functions +----------------------------------------------------- +getRangeStart :: Range -> Position +getRangeStart (Range_Range start _) = start + +getRangeEnd :: Range -> Position +getRangeEnd (Range_Range _ end) = end + +getStatementRange :: Statement -> Range +getStatementRange s = + case s of + Statement_Expression r _ -> r + Statement_Let r _ -> r + Statement_Generator r _ _ -> r + Statement_Empty r -> r + +getPatRange :: Pattern -> Range +getPatRange (Pattern_As r _ _) = r +getPatRange (Pattern_Constructor r _ _) = r +getPatRange (Pattern_InfixConstructor r _ _ _) = r +getPatRange (Pattern_Irrefutable r _) = r +getPatRange (Pattern_List r _) = r +getPatRange (Pattern_Literal r _) = r +getPatRange (Pattern_Negate r _) = r +getPatRange (Pattern_NegateFloat r _) = r +getPatRange (Pattern_Parenthesized r _) = r +getPatRange (Pattern_Record r _ _) = r +getPatRange (Pattern_Successor r _ _) = r +getPatRange (Pattern_Tuple r _) = r +getPatRange (Pattern_Variable r _) = r +getPatRange (Pattern_Wildcard r) = r +getPatRange (Pattern_Hole r _) = r + +getExprRange :: Expression -> Range +getExprRange (Expression_Literal r _ ) = r +getExprRange (Expression_Hole r _ ) = r +getExprRange (Expression_Variable r _ ) = r +getExprRange (Expression_Constructor r _ ) = r +getExprRange (Expression_Parenthesized r _ ) = r +getExprRange (Expression_NormalApplication r _ _ ) = r +getExprRange (Expression_InfixApplication r _ _ _) = r +getExprRange (Expression_If r _ _ _) = r +getExprRange (Expression_Lambda r _ _ ) = r +getExprRange (Expression_Case r _ _ ) = r +getExprRange (Expression_Let r _ _ ) = r +getExprRange (Expression_Do r _ ) = r +getExprRange (Expression_List r _ ) = r +getExprRange (Expression_Tuple r _ ) = r +getExprRange (Expression_Comprehension r _ _ ) = r +getExprRange (Expression_Typed r _ _ ) = r +getExprRange (Expression_RecordConstruction r _ _ ) = r +getExprRange (Expression_RecordUpdate r _ _ ) = r +getExprRange (Expression_Enum r _ _ _) = r +getExprRange (Expression_Negate r _ ) = r +getExprRange (Expression_NegateFloat r _ ) = r +getExprRange (Expression_Feedback r _ _ ) = r +getExprRange (Expression_MustUse _ _ ) = error "not supported" + +getRHSRange :: RightHandSide -> Range +getRHSRange (RightHandSide_Expression r _ _) = r +getRHSRange (RightHandSide_Guarded r _ _) = r + +getMaybeExprRange :: MaybeExpression -> Range +getMaybeExprRange (MaybeExpression_Just e) = getExprRange e +getMaybeExprRange (MaybeExpression_Nothing) = noRange + +getLitRange :: Literal -> Range +getLitRange (Literal_Char r _) = r +getLitRange (Literal_Float r _) = r +getLitRange (Literal_Int r _) = r +getLitRange (Literal_String r _) = r + +getQualifierRange :: Qualifier -> Range +getQualifierRange qualifier = case qualifier of + Qualifier_Guard r _ -> r + Qualifier_Let r _ -> r + Qualifier_Generator r _ _ -> r + Qualifier_Empty r -> r + +getAlternativeRange :: Alternative -> Range +getAlternativeRange alternative = case alternative of + Alternative_Alternative r _ _ -> r + Alternative_Empty r -> r + Alternative_Feedback _ _ _ -> error "not supported" + Alternative_Hole _ _ -> error "not supported" + +getLHSRange :: LeftHandSide -> Range +getLHSRange lhs = case lhs of + LeftHandSide_Function r _ _ -> r + LeftHandSide_Infix r _ _ _ -> r + LeftHandSide_Parenthesized r _ _ -> r + +getFBRange :: FunctionBinding -> Range +getFBRange fb = case fb of + FunctionBinding_FunctionBinding r _ _ -> r + FunctionBinding_Feedback _ _ _ -> error "not supported" + FunctionBinding_Hole _ _ -> error "not supported" + +getDeclarationRange :: Declaration -> Range +getDeclarationRange decl = case decl of + Declaration_Type r _ _ -> r + Declaration_Data r _ _ _ _ -> r + Declaration_Newtype r _ _ _ _ -> r + Declaration_Class r _ _ _ -> r + Declaration_Instance r _ _ _ _ -> r + Declaration_Default r _ -> r + Declaration_FunctionBindings r _ -> r + Declaration_PatternBinding r _ _ -> r + Declaration_TypeSignature r _ _ -> r + Declaration_Fixity r _ _ _ -> r + Declaration_Empty r -> r + Declaration_Hole r _ -> r + +getBodyRange :: Body -> Range +getBodyRange body = case body of + Body_Body r _ _ -> r + Body_Hole _ _ -> error "not supported" + +getTypeRange :: Type -> Range +getTypeRange tp = case tp of + Type_Application r _ _ _ -> r + Type_Variable r _ -> r + Type_Constructor r _ -> r + Type_Qualified r _ _ -> r + Type_Forall r _ _ -> r + Type_Exists r _ _ -> r + Type_Parenthesized r _ -> r + +getGuardedExprRange :: GuardedExpression -> Range +getGuardedExprRange gexpr = case gexpr of + GuardedExpression_GuardedExpression r _ _ -> r + +getRHSRangeSpecial :: RightHandSide -> Range +getRHSRangeSpecial rhs = case rhs of + RightHandSide_Expression _ expr _ -> getExprRange expr + RightHandSide_Guarded r _ _ -> r + +showRanges :: [Range] -> String +showRanges (range:ranges) = show range ++ concatMap ((", " ++) . show) ranges +showRanges [] = "" + +-- !!!! In the special case that the range corresponds to the import range, +-- the module name of the second position should be printed +showRange :: Range -> String +showRange range@(Range_Range startPos endPos) + | isImportRange range = + moduleFromPosition endPos + | otherwise = + showPosition startPos + +showFullRange :: Range -> String +showFullRange (Range_Range startPos endPos) = + showPosition startPos ++ "-" ++ showPosition endPos + +showPosition :: Position -> String +showPosition (Position_Position _ line column) = + "(" ++ show line ++ "," ++ show column ++ ")" +showPosition _ = + "" + +sortRanges :: [Range] -> [Range] +sortRanges ranges = let (xs,ys) = partition isImportRange ranges + in sort ys ++ xs + +moduleFromPosition :: Position -> String +moduleFromPosition pos = + case pos of + Position_Position moduleName _ _ -> + moduleName + _ -> + internalError "UHA_Range" "moduleFromPosition" "unknown position" + diff --git a/src/Helium/Syntax/UHA_Syntax.ag b/src/Helium/Syntax/UHA_Syntax.ag new file mode 100644 --- /dev/null +++ b/src/Helium/Syntax/UHA_Syntax.ag @@ -0,0 +1,816 @@ +-- last changed: Andres Loeh, May 21, 2002 + +-- Read using a monospaced font! + +-- At some places we still have to look at, +-- a "-- ToDo:" comment is inserted + +-- ------------------------------------------------------------------------ +-- -- Modules -- +-- ------------------------------------------------------------------------ + +DATA Module + | Module + range : Range + name : MaybeName + exports : MaybeExports + body : Body + +TYPE Exports = [ Export ] + +DATA MaybeExports + | Nothing + | Just + exports : Exports + +DATA Export + | Variable + range : Range + name : Name + | TypeOrClass + range : Range + name : Name + names : MaybeNames -- constructors or field names or class methods + | TypeOrClassComplete + range : Range + name : Name + | Module + range : Range + name : Name -- this is a module name + +-- Since the parser cannot distinguish between types or constructors, +-- or between types and type classes, we do not have different cases (yet?). + +DATA Body + | Hole + range : Range + id : Integer + | Body + range : Range + importdeclarations : ImportDeclarations + declarations : Declarations + +TYPE ImportDeclarations = [ ImportDeclaration ] + +DATA ImportDeclaration + | Import + range : Range + qualified : Bool + name : Name + asname : MaybeName + importspecification : MaybeImportSpecification + | Empty + range : Range + +DATA MaybeImportSpecification + | Nothing + | Just + importspecification : ImportSpecification + +DATA ImportSpecification + | Import + range : Range + hiding : Bool + imports : Imports + +TYPE Imports = [ Import ] + +DATA Import + | Variable + range : Range + name : Name + | TypeOrClass + range : Range + name : Name + names : MaybeNames -- constructors or field names or class methods + | TypeOrClassComplete + range : Range + name : Name + +-- cf. Export + +-- ------------------------------------------------------------------------ +-- -- Declarations -- +-- ------------------------------------------------------------------------ + +DATA MaybeDeclarations + | Nothing + | Just + declarations : Declarations + +TYPE Declarations = [ Declaration ] + +DATA Declaration {- *** -} + | Hole + range : Range + id : Integer + | Type + range : Range + simpletype : SimpleType + type : Type + | Data {- *** -} + range : Range + context : ContextItems + simpletype : SimpleType + constructors : Constructors + derivings : Names + | Newtype + range : Range + context : ContextItems + simpletype : SimpleType + constructor : Constructor -- has only one field, no strictness + derivings : Names + | Class + range : Range + context : ContextItems -- is a "simple" context + simpletype : SimpleType -- Haskell 98 allows only one variable + where : MaybeDeclarations -- cannot have everything + | Instance + range : Range + context : ContextItems -- is a "simple" context + name : Name + types : Types -- Haskell 98 allows only one type + -- that is severely restricted + where : MaybeDeclarations -- cannot have everything + | Default + range : Range + types : Types -- should be instances of Num + | FunctionBindings {- *** -} + range : Range + bindings : FunctionBindings -- should all be for the same function + | PatternBinding + range : Range + pattern : Pattern + righthandside : RightHandSide + | TypeSignature + range : Range + names : Names + type : Type -- may have context + | Fixity + range : Range + fixity : Fixity + priority : MaybeInt + operators : Names + | Empty + range : Range + +DATA Fixity + | Infixl + range : Range + | Infixr + range : Range + | Infix + range : Range + +-- ------------------------------------------------------------------------ +-- -- Types -- +-- ------------------------------------------------------------------------ + +TYPE Types = [Type] + +DATA Type {- *** -} + | Application {- *** -} + range : Range + prefix : Bool + function : Type + arguments : Types + | Variable {- *** -} + range : Range + name : Name + | Constructor {- *** -} + range : Range + name : Name + | Qualified + range : Range + context : ContextItems + type : Type + | Forall + range : Range + typevariables : Names + type : Type + | Exists + range : Range + typevariables : Names + type : Type + | Parenthesized + range : Range + type : Type + +-- Representation examples (ranges are skipped): +-- o "(Int,Int,Int)" as +-- +-- Type_Application +-- False (Type_Constructor (Name_Special "(,,)")) +-- [Type_Constructor (Name_Identifier "Int") +-- ,Type_Constructor (Name_Identifier "Int") +-- ,Type_Constructor (Name_Identifier "Int")] +-- +-- o "(,,) Int Int Int" as +-- +-- Type_Application +-- True (Type_Constructor (Name_Special "(,,)")) +-- [Type_Constructor (Name_Identifier "Int") +-- ,Type_Constructor (Name_Identifier "Int") +-- ,Type_Constructor (Name_Identifier "Int")] +-- +-- o "((,,) Int) Int Int" as +-- +-- Type_Application +-- True +-- (Type_Parenthesized +-- (Type_Application +-- True (Type_Constructor (Name_Special "(,,)")) +-- [Type_Constructor (Name_Identifier "Int")])) +-- [Type_Constructor (Name_Identifier "Int") +-- ,Type_Constructor (Name_Identifier "Int")] +-- +-- o "Int -> Int" as +-- +-- Type_Application +-- False (Type_Constructor (Name_Special "->")) +-- [Type_Constructor (Name_Identifier "Int") +-- ,Type_Constructor (Name_Identifier "Int")] +-- +-- o "(->) Int Int" as +-- +-- Type_Application +-- True (Type_Constructor (Name_Special "->")) +-- [Type_Constructor (Name_Identifier "Int") +-- ,Type_Constructor (Name_Identifier "Int")] +-- +-- o "Tree Int" as +-- +-- Type_Application +-- True (Type_Constructor (Name_Identifier "Tree")) +-- [Type_Constructor (Name_Identifier "Int")] + + +DATA SimpleType + | SimpleType + range : Range + name : Name + typevariables : Names + +TYPE ContextItems = [ ContextItem ] + +DATA ContextItem + | ContextItem -- ToDo: or _Item? + range : Range + name : Name -- that is the class + types : Types -- in Haskell 98, this is only one type + +TYPE Constructors = [ Constructor ] + +DATA Constructor + | Constructor + range : Range + constructor : Name + types : AnnotatedTypes + | Infix + range : Range + leftType : AnnotatedType + constructorOperator : Name + rightType : AnnotatedType + | Record + range : Range + constructor : Name + fieldDeclarations : FieldDeclarations + +TYPE FieldDeclarations = [ FieldDeclaration ] + +DATA FieldDeclaration + | FieldDeclaration + range : Range + names : Names + type : AnnotatedType + +TYPE AnnotatedTypes = [ AnnotatedType ] + +DATA AnnotatedType + | AnnotatedType -- ToDo: or _Type? + range : Range + strict : Bool + type : Type + +-- ------------------------------------------------------------------------ +-- -- Expressions -- +-- ------------------------------------------------------------------------ + +TYPE Expressions = [ Expression ] + +DATA MaybeExpression + | Nothing + | Just + expression : Expression + +DATA Expression {- *** -} + | Hole + range : Range + id : Integer + | Feedback + range : Range + feedback : String + expression : Expression + | MustUse + range : Range + expression : Expression + | Literal {- *** -} + range : Range + literal : Literal + | Variable {- *** -} + range : Range + name : Name + | Constructor {- *** -} + range : Range + name : Name + | Parenthesized + range : Range + expression : Expression + | NormalApplication {- *** -} + range : Range + function : Expression + arguments : Expressions + | InfixApplication + range : Range + leftExpression : MaybeExpression + operator : Expression + rightExpression : MaybeExpression + | If + range : Range + guardExpression : Expression + thenExpression : Expression + elseExpression : Expression + | Lambda {- *** -} + range : Range + patterns : Patterns + expression : Expression + | Case {- *** -} + range : Range + expression : Expression + alternatives : Alternatives + | Let {- *** -} + range : Range + declarations : Declarations + expression : Expression + | Do + range : Range + statements : Statements + | List + range : Range + expressions : Expressions + | Tuple + range : Range + expressions : Expressions + | Comprehension + range : Range + expression : Expression + qualifiers : Qualifiers + | Typed {- ??? -} + range : Range + expression : Expression + type : Type + | RecordConstruction + range : Range + name : Name + recordExpressionBindings : RecordExpressionBindings + | RecordUpdate + range : Range + expression : Expression + recordExpressionBindings : RecordExpressionBindings + | Enum + range : Range + from : Expression + then : MaybeExpression + to : MaybeExpression + | Negate + range : Range + expression : Expression + +-- Helium + | NegateFloat + range : Range + expression : Expression + +-- Representation examples (ranges are skipped): +-- +-- o "(+) 2 3" as +-- +-- Expression_NormalApplication +-- (Expression_InfixApplication +-- Nothing (Name_Operator [] "+") Nothing) +-- [Expression_Literal (Literal_Int "2") +-- ,Expression_Literal (Literal_Int "3")] +-- +-- ToDo: Now that we distinguish operators from identifiers, is +-- there a good reason not to say +-- +-- Expression_NormalApplication +-- (Expression_Variable (Name_Operator [] "+")) +-- [Expression_Literal (Literal_Int "2") +-- ,Expression_Literal (Literal_Int "3")] +-- +-- o "(+3) 2" as +-- +-- Expression_NormalApplication +-- (Expression_InfixApplication +-- Nothing (Name_Operator [] "+") +-- (Just (Expression_Literal (Literal_Int "3")))) +-- [Expression_Literal (Literal_Int "2")] +-- +-- o "(2+) 3" as +-- +-- Expression_NormalApplication +-- (Expression_InfixApplication +-- (Just (Expression_Literal (Literal_Int "2"))) +-- (Name_Operator [] "+") Nothing) +-- [Expression_Literal (Literal_Int "3")] +-- +-- o "2 + 3" as +-- +-- Expression_InfixApplication +-- (Just (Expression_Literal (Literal_Int "2"))) +-- (Name_Operator [] "+") +-- (Just (Expression_Literal (Literal_Int "3"))) +-- +-- o "mod 5 2" as +-- +-- Expression_NormalApplication +-- (Expression_Variable (Name_Identifier [] "mod")) +-- [Expression_Literal (Literal_Int "5") +-- ,Expression_Literal (Literal_Int "3")] +-- +-- o "(`mod` 2) 5" as +-- +-- Expression_NormalApplication +-- (Expression_InfixApplication +-- Nothing (Name_Identifier [] "mod") +-- (Just (Expression_Literal (Literal_Int "2")))) +-- [Expression_Literal (Literal_Int "5")] +-- +-- o "(5 `mod`) 2" as +-- +-- Expression_NormalApplication +-- (Expression_InfixApplication +-- (Just (Expression_Literal (Literal_Int "5"))) +-- (Name_Identifier [] "mod") Nothing) +-- [Expression_Literal (Literal_Int "2")] +-- +-- o "(mod 5) 2" as +-- +-- Expression_NormalApplication +-- (Expression_Parenthesized +-- (Expression_NormalApplication +-- (Expression_Variable (Name_Identifier [] "mod")) +-- [Expression_Literal (Literal_Int "5")])) +-- [Expression_Literal (Literal_Int "2")] +-- +-- o "5 `mod` 2" as +-- +-- Expression_InfixApplication +-- (Just (Expression_Literal (Literal_Int "5"))) +-- (Name_Identifier [] "mod") +-- (Just (Expression_Literal (Literal_Int "2"))) +-- +-- o "-2" as +-- +-- Expression_Negate (Expression_Literal (Literal_Int "2")) +-- +-- o "(-2)" as +-- +-- Expression_Parenthesized +-- (Expression_Negate (Expression_Literal (Literal_Int "2"))) +-- +-- o "(2-)" as +-- +-- Expression_InfixApplication +-- (Just (Expression_Literal (Literal_Int "2"))) +-- (Name_Operator [] "-") Nothing +-- +-- Summary: +-- Sections are represented as partial infix applications. Backquotes +-- and parentheses that originate from pre/in-fixing an operator/identifier +-- are not stored explicitly. + +TYPE Statements = [ Statement ] + +DATA Statement + | Expression + range : Range + expression : Expression + | Let + range : Range + declarations : Declarations + | Generator + range : Range + pattern : Pattern + expression : Expression + | Empty + range : Range + +TYPE Qualifiers = [ Qualifier ] + +DATA Qualifier + | Guard + range : Range + guard : Expression -- type: Boolean + | Let + range : Range + declarations : Declarations + | Generator + range : Range + pattern : Pattern + expression : Expression + | Empty + range : Range + +TYPE Alternatives = [ Alternative ] + +DATA Alternative + | Hole + range : Range + id : Integer + | Feedback + range : Range + feedback : String + alternative : Alternative + | Alternative + range : Range + pattern : Pattern + righthandside : RightHandSide + | Empty + range : Range + +TYPE GuardedExpressions = [ GuardedExpression ] + +DATA GuardedExpression -- ToDo: or _Guard? + | GuardedExpression + range : Range + guard : Expression -- type: Boolean + expression : Expression + +TYPE RecordExpressionBindings = [ RecordExpressionBinding ] + +DATA RecordExpressionBinding + | RecordExpressionBinding -- ToDo: or _Binding? + range : Range + name : Name + expression : Expression + +TYPE RecordPatternBindings = [ RecordPatternBinding ] + +DATA RecordPatternBinding + | RecordPatternBinding -- ToDo: or _Binding? + range : Range + name : Name + pattern : Pattern + +TYPE FunctionBindings = [ FunctionBinding ] + +DATA FunctionBinding + | Hole + range : Range + id : Integer + | Feedback + range : Range + feedback : String + functionBinding : FunctionBinding + | FunctionBinding + range : Range + lefthandside : LeftHandSide + righthandside : RightHandSide + +DATA LeftHandSide + | Function + range : Range + name : Name + patterns : Patterns + | Infix + range : Range + leftPattern : Pattern + operator : Name + rightPattern : Pattern + | Parenthesized + range : Range + lefthandside : LeftHandSide + patterns : Patterns + +DATA RightHandSide + | Expression + range : Range + expression : Expression + where : MaybeDeclarations + | Guarded + range : Range + guardedexpressions : GuardedExpressions + where : MaybeDeclarations + +-- ------------------------------------------------------------------------ +-- -- Patterns -- +-- ------------------------------------------------------------------------ + +TYPE Patterns = [ Pattern ] + +DATA Pattern + | Hole + range : Range + id : Integer + | Literal {- *** -} + range : Range + literal : Literal + | Variable {- *** -} + range : Range + name : Name + | Constructor {- *** -} + range : Range + name : Name + patterns : Patterns + | Parenthesized + range : Range + pattern : Pattern + | InfixConstructor + range : Range + leftPattern : Pattern + constructorOperator : Name + rightPattern : Pattern + | List + range : Range + patterns : Patterns + | Tuple + range : Range + patterns : Patterns + | Record + range : Range + name : Name + recordPatternBindings : RecordPatternBindings + | Negate + range : Range + literal : Literal -- only numbers allowed here + | As {- ??? -} + range : Range + name : Name + pattern : Pattern + | Wildcard + range : Range + | Irrefutable + range : Range + pattern : Pattern + | Successor -- n+k patterns + range : Range + name : Name + literal : Literal -- only integers allowed here +-- Helium + | NegateFloat + range : Range + literal : Literal -- only numbers allowed here + +-- ------------------------------------------------------------------------ +-- -- Basics -- +-- ------------------------------------------------------------------------ + +DATA Literal {- *** -} + | Int {- *** -} + range : Range + value : String + | Char {- *** -} + range : Range + value : String -- without the quotes + | Float + range : Range + value : String + | String {- ??? -} + range : Range + value : String -- without the quotes + +TYPE Names = [ Name ] + +DATA MaybeNames + | Nothing + | Just + names : Names + +DATA MaybeName + | Nothing + | Just + name : Name + +DATA Name {- *** -} + | Identifier {- *** -} + range : Range + module : Strings + name : String + | Operator + range : Range + module : Strings + name : String + | Special + range : Range + module : Strings + name : String + +-- Normal identifiers should be stored as "Name_Identifier". +-- Symbolic identifiers or operators that are usually applied infix +-- should be stored as "Name_Operator". +-- "Name_Special" is reserved for: +-- o (on the type level:) the function space arrow, the unit type, +-- all tuple type constructors, the list type constructor +-- o (on the value level:) unit, all tuple value constructors, the +-- empty list +-- The field "module" can be used to store qualifications. If the +-- name occurs unqualified, the empty list is used. Multiple list +-- entries can be used to support a hierarchical module space +-- (as supported in recent versions of GHC). + +TYPE Strings = [ String ] + +DATA MaybeInt + | Nothing + | Just + int : Int + +DATA Range + | Range + start : Position + stop : Position + +DATA Position + | Position + filename : String + line : Int + column : Int + | Unknown + +{-| Module : UHA_Range + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + + +{- + +Documented Design Decisions: + + o All names are spelt out. + + o All constructor names are prefixed with the type name followed by + an underscore. This preserves uniqueness, and the AG system can + do that automatically. + + o Ranges are included everywhere as the first field, except + in list and maybe types. + + o Naming convention for list types: append an `s' to the name of + the element type. + + o Naming convention for maybe types: prepend base type with `Maybe'. + + o All of Haskell should be expressible without too much reinterpretation. + That means that the syntax contains cases for ugly constructs such + as the `default' statement or n+k/successor patterns. + + o We keep a few extensions in mind and are thus more general than + Haskell in many places. For instance, the abstract syntax allows: + <> multi-parameter type classes + <> existential types + <> rank-n polymorphic and qualified types + <> hierarchical module names + <> Haskell toplevel declarations everywhere + + o `Expression_InfixApplication' is used to store sections and + prefixed operators. + + o General where rule: A "where" with no declarations is represented + as "Just []". A missing "where" clause is represented as "Nothing". + + o If two different cases can be joined into one by using a `Bool' + to distinguish or by using maybe types, then they _usually_ should. + + o Literals are stored as strings rather than in their corresponding + Haskell types, leaving it to each project to do conversions if + necessary. The strings should store the literal in the same + way as it appears in the source, but without the single or double + quotes for character or string literals. + + o We do not include nonterminals that do not have resemblance in the + concrete syntax, although they might be convenient for AG usage. + Examples discussed were special root-like nonterminals for expressions + and types, or a `BindingGroup' nonterminal. + + o Although parentheses can be represented in the abstract syntax, + the program using it will probably not always do so. For instance, + most compilers will work on type expressions and not insert parentheses + at the correct positions. There might be different pretty printers needed: + literal and optimizing. + + ToDo: Create different levels of the abstract syntax. + Types, constructors, maybe even fields should be categorised. + There should be a really small core, and different standardised + extensions levels. Some of the extensions might even be not + yet discussed at all (kinds, functional dependencies, ...) + Andres has started marking some types and some constructors + he thinks are most important with {- *** -}. + +-} + diff --git a/src/Helium/Syntax/UHA_Syntax.hs b/src/Helium/Syntax/UHA_Syntax.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Syntax/UHA_Syntax.hs @@ -0,0 +1,207 @@ + + +-- UUAGC 0.9.42.2 (Helium/Syntax/UHA_Syntax.ag) +module Helium.Syntax.UHA_Syntax where +-- Alternative ------------------------------------------------- +data Alternative = Alternative_Hole (Range) (Integer) + | Alternative_Feedback (Range) (String) (Alternative) + | Alternative_Alternative (Range) (Pattern) (RightHandSide) + | Alternative_Empty (Range) +-- Alternatives ------------------------------------------------ +type Alternatives = [Alternative] +-- AnnotatedType ----------------------------------------------- +data AnnotatedType = AnnotatedType_AnnotatedType (Range) (Bool) (Type) +-- AnnotatedTypes ---------------------------------------------- +type AnnotatedTypes = [AnnotatedType] +-- Body -------------------------------------------------------- +data Body = Body_Hole (Range) (Integer) + | Body_Body (Range) (ImportDeclarations) (Declarations) +-- Constructor ------------------------------------------------- +data Constructor = Constructor_Constructor (Range) (Name) (AnnotatedTypes) + | Constructor_Infix (Range) (AnnotatedType) (Name) (AnnotatedType) + | Constructor_Record (Range) (Name) (FieldDeclarations) +-- Constructors ------------------------------------------------ +type Constructors = [Constructor] +-- ContextItem ------------------------------------------------- +data ContextItem = ContextItem_ContextItem (Range) (Name) (Types) +-- ContextItems ------------------------------------------------ +type ContextItems = [ContextItem] +-- Declaration ------------------------------------------------- +data Declaration = Declaration_Hole (Range) (Integer) + | Declaration_Type (Range) (SimpleType) (Type) + | Declaration_Data (Range) (ContextItems) (SimpleType) (Constructors) (Names) + | Declaration_Newtype (Range) (ContextItems) (SimpleType) (Constructor) (Names) + | Declaration_Class (Range) (ContextItems) (SimpleType) (MaybeDeclarations) + | Declaration_Instance (Range) (ContextItems) (Name) (Types) (MaybeDeclarations) + | Declaration_Default (Range) (Types) + | Declaration_FunctionBindings (Range) (FunctionBindings) + | Declaration_PatternBinding (Range) (Pattern) (RightHandSide) + | Declaration_TypeSignature (Range) (Names) (Type) + | Declaration_Fixity (Range) (Fixity) (MaybeInt) (Names) + | Declaration_Empty (Range) +-- Declarations ------------------------------------------------ +type Declarations = [Declaration] +-- Export ------------------------------------------------------ +data Export = Export_Variable (Range) (Name) + | Export_TypeOrClass (Range) (Name) (MaybeNames) + | Export_TypeOrClassComplete (Range) (Name) + | Export_Module (Range) (Name) +-- Exports ----------------------------------------------------- +type Exports = [Export] +-- Expression -------------------------------------------------- +data Expression = Expression_Hole (Range) (Integer) + | Expression_Feedback (Range) (String) (Expression) + | Expression_MustUse (Range) (Expression) + | Expression_Literal (Range) (Literal) + | Expression_Variable (Range) (Name) + | Expression_Constructor (Range) (Name) + | Expression_Parenthesized (Range) (Expression) + | Expression_NormalApplication (Range) (Expression) (Expressions) + | Expression_InfixApplication (Range) (MaybeExpression) (Expression) (MaybeExpression) + | Expression_If (Range) (Expression) (Expression) (Expression) + | Expression_Lambda (Range) (Patterns) (Expression) + | Expression_Case (Range) (Expression) (Alternatives) + | Expression_Let (Range) (Declarations) (Expression) + | Expression_Do (Range) (Statements) + | Expression_List (Range) (Expressions) + | Expression_Tuple (Range) (Expressions) + | Expression_Comprehension (Range) (Expression) (Qualifiers) + | Expression_Typed (Range) (Expression) (Type) + | Expression_RecordConstruction (Range) (Name) (RecordExpressionBindings) + | Expression_RecordUpdate (Range) (Expression) (RecordExpressionBindings) + | Expression_Enum (Range) (Expression) (MaybeExpression) (MaybeExpression) + | Expression_Negate (Range) (Expression) + | Expression_NegateFloat (Range) (Expression) +-- Expressions ------------------------------------------------- +type Expressions = [Expression] +-- FieldDeclaration -------------------------------------------- +data FieldDeclaration = FieldDeclaration_FieldDeclaration (Range) (Names) (AnnotatedType) +-- FieldDeclarations ------------------------------------------- +type FieldDeclarations = [FieldDeclaration] +-- Fixity ------------------------------------------------------ +data Fixity = Fixity_Infixl (Range) + | Fixity_Infixr (Range) + | Fixity_Infix (Range) +-- FunctionBinding --------------------------------------------- +data FunctionBinding = FunctionBinding_Hole (Range) (Integer) + | FunctionBinding_Feedback (Range) (String) (FunctionBinding) + | FunctionBinding_FunctionBinding (Range) (LeftHandSide) (RightHandSide) +-- FunctionBindings -------------------------------------------- +type FunctionBindings = [FunctionBinding] +-- GuardedExpression ------------------------------------------- +data GuardedExpression = GuardedExpression_GuardedExpression (Range) (Expression) (Expression) +-- GuardedExpressions ------------------------------------------ +type GuardedExpressions = [GuardedExpression] +-- Import ------------------------------------------------------ +data Import = Import_Variable (Range) (Name) + | Import_TypeOrClass (Range) (Name) (MaybeNames) + | Import_TypeOrClassComplete (Range) (Name) +-- ImportDeclaration ------------------------------------------- +data ImportDeclaration = ImportDeclaration_Import (Range) (Bool) (Name) (MaybeName) (MaybeImportSpecification) + | ImportDeclaration_Empty (Range) +-- ImportDeclarations ------------------------------------------ +type ImportDeclarations = [ImportDeclaration] +-- ImportSpecification ----------------------------------------- +data ImportSpecification = ImportSpecification_Import (Range) (Bool) (Imports) +-- Imports ----------------------------------------------------- +type Imports = [Import] +-- LeftHandSide ------------------------------------------------ +data LeftHandSide = LeftHandSide_Function (Range) (Name) (Patterns) + | LeftHandSide_Infix (Range) (Pattern) (Name) (Pattern) + | LeftHandSide_Parenthesized (Range) (LeftHandSide) (Patterns) +-- Literal ----------------------------------------------------- +data Literal = Literal_Int (Range) (String) + | Literal_Char (Range) (String) + | Literal_Float (Range) (String) + | Literal_String (Range) (String) +-- MaybeDeclarations ------------------------------------------- +data MaybeDeclarations = MaybeDeclarations_Nothing + | MaybeDeclarations_Just (Declarations) +-- MaybeExports ------------------------------------------------ +data MaybeExports = MaybeExports_Nothing + | MaybeExports_Just (Exports) +-- MaybeExpression --------------------------------------------- +data MaybeExpression = MaybeExpression_Nothing + | MaybeExpression_Just (Expression) +-- MaybeImportSpecification ------------------------------------ +data MaybeImportSpecification = MaybeImportSpecification_Nothing + | MaybeImportSpecification_Just (ImportSpecification) +-- MaybeInt ---------------------------------------------------- +data MaybeInt = MaybeInt_Nothing + | MaybeInt_Just (Int) +-- MaybeName --------------------------------------------------- +data MaybeName = MaybeName_Nothing + | MaybeName_Just (Name) +-- MaybeNames -------------------------------------------------- +data MaybeNames = MaybeNames_Nothing + | MaybeNames_Just (Names) +-- Module ------------------------------------------------------ +data Module = Module_Module (Range) (MaybeName) (MaybeExports) (Body) +-- Name -------------------------------------------------------- +data Name = Name_Identifier (Range) (Strings) (String) + | Name_Operator (Range) (Strings) (String) + | Name_Special (Range) (Strings) (String) +-- Names ------------------------------------------------------- +type Names = [Name] +-- Pattern ----------------------------------------------------- +data Pattern = Pattern_Hole (Range) (Integer) + | Pattern_Literal (Range) (Literal) + | Pattern_Variable (Range) (Name) + | Pattern_Constructor (Range) (Name) (Patterns) + | Pattern_Parenthesized (Range) (Pattern) + | Pattern_InfixConstructor (Range) (Pattern) (Name) (Pattern) + | Pattern_List (Range) (Patterns) + | Pattern_Tuple (Range) (Patterns) + | Pattern_Record (Range) (Name) (RecordPatternBindings) + | Pattern_Negate (Range) (Literal) + | Pattern_As (Range) (Name) (Pattern) + | Pattern_Wildcard (Range) + | Pattern_Irrefutable (Range) (Pattern) + | Pattern_Successor (Range) (Name) (Literal) + | Pattern_NegateFloat (Range) (Literal) +-- Patterns ---------------------------------------------------- +type Patterns = [Pattern] +-- Position ---------------------------------------------------- +data Position = Position_Position (String) (Int) (Int) + | Position_Unknown +-- Qualifier --------------------------------------------------- +data Qualifier = Qualifier_Guard (Range) (Expression) + | Qualifier_Let (Range) (Declarations) + | Qualifier_Generator (Range) (Pattern) (Expression) + | Qualifier_Empty (Range) +-- Qualifiers -------------------------------------------------- +type Qualifiers = [Qualifier] +-- Range ------------------------------------------------------- +data Range = Range_Range (Position) (Position) +-- RecordExpressionBinding ------------------------------------- +data RecordExpressionBinding = RecordExpressionBinding_RecordExpressionBinding (Range) (Name) (Expression) +-- RecordExpressionBindings ------------------------------------ +type RecordExpressionBindings = [RecordExpressionBinding] +-- RecordPatternBinding ---------------------------------------- +data RecordPatternBinding = RecordPatternBinding_RecordPatternBinding (Range) (Name) (Pattern) +-- RecordPatternBindings --------------------------------------- +type RecordPatternBindings = [RecordPatternBinding] +-- RightHandSide ----------------------------------------------- +data RightHandSide = RightHandSide_Expression (Range) (Expression) (MaybeDeclarations) + | RightHandSide_Guarded (Range) (GuardedExpressions) (MaybeDeclarations) +-- SimpleType -------------------------------------------------- +data SimpleType = SimpleType_SimpleType (Range) (Name) (Names) +-- Statement --------------------------------------------------- +data Statement = Statement_Expression (Range) (Expression) + | Statement_Let (Range) (Declarations) + | Statement_Generator (Range) (Pattern) (Expression) + | Statement_Empty (Range) +-- Statements -------------------------------------------------- +type Statements = [Statement] +-- Strings ----------------------------------------------------- +type Strings = [(String)] +-- Type -------------------------------------------------------- +data Type = Type_Application (Range) (Bool) (Type) (Types) + | Type_Variable (Range) (Name) + | Type_Constructor (Range) (Name) + | Type_Qualified (Range) (ContextItems) (Type) + | Type_Forall (Range) (Names) (Type) + | Type_Exists (Range) (Names) (Type) + | Type_Parenthesized (Range) (Type) +-- Types ------------------------------------------------------- +type Types = [Type] diff --git a/src/Helium/Syntax/UHA_Utils.hs b/src/Helium/Syntax/UHA_Utils.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Syntax/UHA_Utils.hs @@ -0,0 +1,150 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| Module : UHA_Utils + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Utilities to extract data from the syntax tree +-} + +module Helium.Syntax.UHA_Utils where + +--import Helium.UHA_Range(noRange, getNameRange) + +import Helium.Syntax.UHA_Range --altered for Holmes +import Data.Maybe --added for Holmes +import Helium.Syntax.UHA_Syntax --added for Holmes +import Lvm.Common.Id(Id, idFromString, stringFromId) +import Data.Char + +import Top.Types(isTupleConstructor) +import Helium.Utils.Utils(internalError) + + +instance Eq Name where + n1 == n2 = getNameName n1 == getNameName n2 + +instance Ord Name where + n1 <= n2 = getNameName n1 <= getNameName n2 + +instance Show Name where + show = getNameName + +-------------------------------------------------------------- +-- NameWithRange + +newtype NameWithRange = NameWithRange { nameWithRangeToName :: Name } + +instance Show NameWithRange where + show (NameWithRange name) = + show name ++ " at " ++ show (getNameRange name) + +instance Eq NameWithRange where + NameWithRange name1 == NameWithRange name2 = + (name1, getNameRange name1) == (name2, getNameRange name2) + +instance Ord NameWithRange where + NameWithRange name1 <= NameWithRange name2 = + (name1, getNameRange name1) <= (name2, getNameRange name2) + +-------------------------------------------------------------- + +getNameName :: Name -> String -- !!!Name +getNameName (Name_Identifier _ _ name) = name +getNameName (Name_Operator _ _ name) = name +getNameName (Name_Special _ _ name) = name + +-- added for Holmes +getHolmesName :: String -> Name -> String -- !!!Name +getHolmesName altname (Name_Identifier range _ name) = getFrom range altname ++ "." ++ name +getHolmesName altname (Name_Operator range _ name) = getFrom range altname ++ "." ++ name +getHolmesName altname (Name_Special range _ name) = getFrom range altname ++ "." ++ name + +getFrom :: Range -> [Char] -> [Char] +getFrom range altname = if result == "" then altname else result + where + result = snd $ checkRange range + checkRange _ = fromMaybe ("","") moduleFI + moduleFI = modulesFromImportRange range + +getModuleName :: Module -> String -- added for Holmes +getModuleName (Module_Module _ MaybeName_Nothing _ _) = "" +getModuleName (Module_Module _ (MaybeName_Just name) _ _) = show name + +idFromName :: Name -> Id -- !!!Name +idFromName (Name_Special _ _ s) = idFromString s +idFromName (Name_Identifier _ _ s) = idFromString s +idFromName (Name_Operator _ _ s) = idFromString s + +nameFromId :: Id -> Name +nameFromId = nameFromString . stringFromId + +nameFromString :: String -> Name -- !!!Name +nameFromString str@(first:_) + | isAlpha first = Name_Identifier noRange [] str + | str == "[]" || isTupleConstructor str || str == "->" + = Name_Special noRange [] str + | otherwise = Name_Operator noRange [] str +nameFromString _ = internalError "UHA_Utils" "nameFromString" "empty string" + +isOperatorName :: Name -> Bool -- !!!Name +isOperatorName (Name_Operator{}) = True +isOperatorName _ = False + +isConstructor :: Name -> Bool -- !!!Name +isConstructor name = + case name of + Name_Operator _ _ (':':_) -> True + Name_Identifier _ _ (first:_) -> isUpper first + Name_Special _ _ "()" -> True + Name_Special _ _ "[]" -> True + _ -> False + +isIdentifierName :: Name -> Bool -- !!!Name +isIdentifierName (Name_Identifier{}) = True +isIdentifierName _ = False + +showNameAsOperator :: Name -> String +showNameAsOperator name + | isIdentifierName name = "`"++show name++"`" + | otherwise = show name + +showNameAsVariable :: Name -> String +showNameAsVariable name + | isOperatorName name = "("++show name++")" + | otherwise = show name + +stringFromImportDeclaration :: ImportDeclaration -> String +stringFromImportDeclaration importDecl = + case importDecl of + ImportDeclaration_Import _ _ n _ _ -> getNameName n + ImportDeclaration_Empty _ -> + internalError "UHA_Utils" "stringFromImportDeclaration" "empty import declaration" + +-- TODO: daan +intUnaryMinusName, floatUnaryMinusName, enumFromName, enumFromToName, enumFromThenName, enumFromThenToName :: Name +intUnaryMinusName = nameFromString "$negate" +floatUnaryMinusName = nameFromString "$floatUnaryMinus" +enumFromName = nameFromString "$enumFrom" +enumFromToName = nameFromString "$enumFromTo" +enumFromThenName = nameFromString "$enumFromThen" +enumFromThenToName = nameFromString "$enumFromThenTo" + +patternVars :: Pattern -> [Name] +patternVars p = case p of + Pattern_Literal _ _ -> [] + Pattern_Variable _ n -> [n] + Pattern_Constructor _ _ ps -> concatMap patternVars ps + Pattern_Parenthesized _ pat -> patternVars pat + Pattern_InfixConstructor _ p1 _ p2 -> concatMap patternVars [p1, p2] + Pattern_List _ ps -> concatMap patternVars ps + Pattern_Tuple _ ps -> concatMap patternVars ps + Pattern_Negate _ _ -> [] + Pattern_As _ n pat -> n : patternVars pat + Pattern_Wildcard _ -> [] + Pattern_Irrefutable _ pat -> patternVars pat + Pattern_NegateFloat _ _ -> [] + _ -> internalError "UHA_Utils" "patternVars" "unsupported kind of pattern" + diff --git a/src/Helium/Utils/Logger.hs b/src/Helium/Utils/Logger.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Utils/Logger.hs @@ -0,0 +1,228 @@ +{-| Module : Logger + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Utils.Logger ( logger, logInternalError ) where + +import Network +import Control.Concurrent + +import Control.Monad +import System.Environment +import Data.Char +import Data.Maybe +import Helium.Main.Args +import System.IO +import Helium.Main.Version +import qualified Control.Exception as CE (catch, IOException) + +{-# NOTINLINE logger #-} + +--------------------------------------------------- +-- Global variables and settings +-- Some additional ones are in Args.hs + +loggerDELAY, loggerTRIES :: Int +loggerDELAY = 10000 -- in micro-seconds +loggerTRIES = 2 + +loggerINTERNALERRORHOSTNAME :: String +loggerINTERNALERRORHOSTNAME = "helium.zoo.cs.uu.nl" +loggerINTERNALERRORPORTNR :: Int +loggerINTERNALERRORPORTNR = loggerDEFAULTPORT + +loggerSEPARATOR, loggerTERMINATOR, loggerUSERNAME, loggerDEFAULTNAME :: String +loggerSEPARATOR = "\NUL\NUL\n" +loggerTERMINATOR = "\SOH\SOH\n" +loggerUSERNAME = "USERNAME" +loggerDEFAULTNAME = "unknown" + +loggerADMINSEPARATOR, escapeChar :: Char +loggerADMINSEPARATOR = '|' +escapeChar = '\\' + +loggerESCAPABLES :: String +loggerESCAPABLES = [loggerADMINSEPARATOR, escapeChar] + +alertESCAPABLES :: String +alertESCAPABLES = "\"" + +debug :: String -> Bool -> IO () +debug s loggerDEBUGMODE = when loggerDEBUGMODE (putStrLn s) + +-- Make sure that options that contain a space are quoted with double quotes. +-- And all double quotes in the options are escaped. +unwordsQuoted :: [String] -> String +unwordsQuoted wrds = unwords (map (quote . escape alertESCAPABLES) wrds) + where + quote s = if ' ' `elem` s then "\"" ++ s ++ "\"" else s -- Not efficient, but balanced. + +------------------------------------------------------ +-- Normalization/escaping functions + +normalizeName :: String -> String +normalizeName name = let + newname = map toLower (filter isAlphaNum name) + in + if null newname then loggerDEFAULTNAME else newname + +-- Escapes all characters from the list escapables +escape :: String -> String -> String +escape _ [] = [] +escape escapables (x:xs) = + if x `elem` escapables + then escapeChar : rest + else rest + where + rest = x : escape escapables xs + +-- Remove line breaks and escape special characters +normalize :: String -> String +normalize = escape loggerESCAPABLES . filter ('\n' /=) + +logInternalError :: Maybe ([String],String) -> IO () +logInternalError maybeSources = + logger "I" maybeSources internalErrorOptions + where + internalErrorOptions = [EnableLogging, Host loggerINTERNALERRORHOSTNAME, Port loggerINTERNALERRORPORTNR] + +------------------------------------------------------ +-- The function to send a message to a socket +-- TODO : decide whether we really don't want to send interpreter input. + +logger :: String -> Maybe ([String],String) -> [Option] -> IO () +logger logcode maybeSources options = + let + debugLogger = DebugLogger `elem` options + reallyLog = EnableLogging `elem` options -- We use that the presence of an alert adds EnableLogging in Options.hs + hostName = fromMaybe loggerDEFAULTHOST (hostFromOptions options) + portNumber = fromMaybe loggerDEFAULTPORT (portFromOptions options) + handlerDef :: CE.IOException -> IO String + handlerDef _ = return loggerDEFAULTNAME + handlerTerm :: CE.IOException -> IO String + handlerTerm _ = return loggerTERMINATOR + in + when reallyLog $ do + debug (hostName ++ ":" ++ show portNumber) debugLogger + username <- getEnv loggerUSERNAME `CE.catch` handlerDef + optionString <- getArgs + sources <- case maybeSources of + Nothing -> + return loggerTERMINATOR + Just (imports,hsFile) -> + do let allHsFiles = hsFile:imports + allFiles = allHsFiles ++ map toTypeFile allHsFiles + xs <- mapM (getContentOfFile debugLogger) allFiles + return (concat (loggerSEPARATOR:xs)++loggerTERMINATOR) + `CE.catch` handlerTerm + {- putStr (normalizeName username ++ + (loggerADMINSEPARATOR : normalize logcode) ++ + (loggerADMINSEPARATOR : normalize version) ++ + (loggerADMINSEPARATOR : normalize (unwords optionString)) ++ + "\n" ++sources) -} + let alertLogcode = if hasAlertOption options then map toLower logcode else map toUpper logcode + sendLogString hostName + portNumber + (normalizeName username ++ + (loggerADMINSEPARATOR : normalize alertLogcode) ++ + (loggerADMINSEPARATOR : normalize version) ++ + (loggerADMINSEPARATOR : normalize (unwordsQuoted optionString)) ++ + "\n" ++sources + ) + debugLogger + +toTypeFile :: String -> String +toTypeFile fullName = fullNameNoExt ++ ".type" + where + (path, baseName, _) = splitFilePath fullName + fullNameNoExt = combinePathAndFile path baseName + +getContentOfFile :: Bool -> String -> IO String +getContentOfFile loggerDEBUGMODE name = + do program <- readFile name + debug ("Logging file " ++ name) loggerDEBUGMODE + return ( fileNameWithoutPath name + ++ "\n" + ++ program + ++ "\n" + ++ loggerSEPARATOR + ) + `CE.catch` handler + where + handler :: CE.IOException -> IO String + handler _ = return "" + +-- isInterpreterModule :: Maybe ([String],String) -> Bool +-- isInterpreterModule Nothing = False +-- isInterpreterModule (Just (_, hsFile)) = fileNameWithoutPath hsFile == "Interpreter.hs" + +sendLogString :: String -> Int -> String -> Bool -> IO () +sendLogString hostName portNr message loggerDEBUGMODE = withSocketsDo (rec_ 0) + where + rec_ i = do --installHandler sigPIPE Ignore Nothing + handle <- connectTo hostName (PortNumber (fromIntegral portNr)) + hSetBuffering handle (BlockBuffering (Just 1024)) + sendToAndFlush handle message loggerDEBUGMODE + `CE.catch` + \exception -> + if i+1 >= loggerTRIES + then debug ( "Could not make a connection: no send (" ++ show (exception :: CE.IOException) ++ ")" ) loggerDEBUGMODE + else do debug ( "Could not make a connection: sleeping (" ++ show exception ++ ")" ) loggerDEBUGMODE + threadDelay loggerDELAY + rec_ (i+1) + +{- from Utils.hs.....because of the import-dependencies, it is not possible to import + this function directly -} +splitFilePath :: String -> (String, String, String) +splitFilePath filePath = + let slashes = "\\/" + (revFileName, revPath) = span (`notElem` slashes) (reverse filePath) + (baseName, ext) = span (/= '.') (reverse revFileName) + in (reverse revPath, baseName, dropWhile (== '.') ext) + +combinePathAndFile :: String -> String -> String +combinePathAndFile path file = + case path of + "" -> file + _ | last path == '/' -> path ++ file + | otherwise -> path ++ "/" ++ file + +fileNameWithoutPath :: String -> String +fileNameWithoutPath filePath = + let slashes = "\\/" + (revFileName, _) = span (`notElem` slashes) (reverse filePath) + in reverse revFileName + +sendToAndFlush :: Handle -- Hostname + -> String -- Message to send + -> Bool -- Debug logger? + -> IO () +sendToAndFlush handle msg loggerDEBUGMODE = do + hPutStr handle msg + hPutStr handle loggerSEPARATOR + hFlush handle +-- b1 <- hIsWritable s +-- b2 <- hIsReadable s +-- putStrLn ((if b1 then "writable" else "not writable") ++ " and " ++ +-- (if b2 then "readable" else "not readable")) + debug "Waiting for a handshake" loggerDEBUGMODE + handshake <- getRetriedLine 0 + debug ("Received a handshake: " ++ show handshake) loggerDEBUGMODE +-- hClose handle + where + getRetriedLine i = hGetLine handle `CE.catch` handler i + handler :: Int -> CE.IOException -> IO String + handler j _ = + if j+1 >= loggerTRIES + then do + debug "Did not receive anything back" loggerDEBUGMODE + return "" + else do + debug "Waiting to try again" loggerDEBUGMODE + threadDelay loggerDELAY + getRetriedLine (j+1) + diff --git a/src/Helium/Utils/OneLiner.hs b/src/Helium/Utils/OneLiner.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Utils/OneLiner.hs @@ -0,0 +1,81 @@ +{-| Module : OneLiner + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable +-} + +module Helium.Utils.OneLiner(OneLineTree(..), showOneLine) where + +import Data.List + +data OneLineTree + = OneLineNode [OneLineTree] + | OneLineText String + +collapseString :: String +collapseString = "..." + +collapseWidth :: Int +collapseWidth = length collapseString + +showOneLine :: Int -> OneLineTree -> String +showOneLine width tree = + case tree of + OneLineText s -> s + OneLineNode ts -> oneLine True width ts + +oneLine :: Bool -> Int -> [OneLineTree] -> String +oneLine toplevel width trees + | not toplevel && -- do not collapse at toplevel + thisLevel > width -- collapse if not even texts can be displayed + = collapseString + | not toplevel && + minSize trees > collapseWidth && + minSize trees > width -- only collapse if that makes things better + = collapseString + | otherwise = concatMap processTree (zip childWidths trees) + where + thisLevel = countThisLevel trees + childSizes = map (\t -> case t of { OneLineText _ -> 0; OneLineNode _ -> maxSize [t]} ) trees + numberedChildren = zip [0..] childSizes + childWidths = map snd (sort (distribute (width - thisLevel) numberedChildren)) + + processTree (_ , OneLineText s) = s + processTree (childWidth, OneLineNode ts) = oneLine False childWidth ts + +maxSize :: [OneLineTree] -> Int +maxSize ts = + let + sizeOne :: OneLineTree -> Int + sizeOne (OneLineText s) = length s + sizeOne (OneLineNode subTs) = maxSize subTs + in + sum (map sizeOne ts) + +minSize :: [OneLineTree] -> Int +minSize ts = + let + sizeOne :: OneLineTree -> Int + sizeOne (OneLineText s) = length s + sizeOne (OneLineNode subTs) = min (minSize subTs) collapseWidth + in + sum (map sizeOne ts) + +countThisLevel :: [OneLineTree] -> Int +countThisLevel ts = + sum [ length s | OneLineText s <- ts ] + + +distribute :: Int -> [(Int, Int)] -> [(Int, Int)] +distribute width children + | null smallChildren = [ (nr, widthPerChild) | (nr, _) <- children ] + | otherwise = + smallChildren ++ distribute leftOvers bigChildren + where + widthPerChild = width `div` length children + (smallChildren, bigChildren) = + partition (\(_, need) -> need <= widthPerChild) children + leftOvers = width - sum (map snd smallChildren) + diff --git a/src/Helium/Utils/Similarity.hs b/src/Helium/Utils/Similarity.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Utils/Similarity.hs @@ -0,0 +1,60 @@ +{-| Module : Similarity + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Check whether identifiers look alike. Identifiers are alike if: + - they are the same when compared insensitive w.r.t. case + - they differ in one character (filter and fi1ter) + - one has a character more than the other (concatMap and concattMap) + - two characters are swapped (filtre and filter) +-} + +module Helium.Utils.Similarity(similar) where + + +import Data.Char +import Helium.Utils.Utils(internalError) + + +similar :: String -> String -> Bool +-- ignore primitives +similar ('$':c:_) _ | isAlpha c = False +similar _ ('$':c:_) | isAlpha c = False +-- normal test +similar name1' name2' = + name1 == name2 + || + oneDiff name1 name2 + || + oneMore name1 name2 + || + oneMore name2 name1 + || + name1 `elem` swap name2 + where + name1 = map toUpper name1' + name2 = map toUpper name2' + +oneMore :: String -> String -> Bool +oneMore xs ys = + length xs - length ys == 1 + && + ys `elem` dropOne xs + +dropOne :: String -> [String] +dropOne [] = [] +dropOne (x:xs) = xs : map (x:) (dropOne xs) + +oneDiff :: String -> String -> Bool +oneDiff xs ys = + length xs == length ys + && + length (filter (== True) (zipWith (==) xs ys)) == length xs - 1 + +swap :: [a] -> [[a]] +swap [_] = [] +swap (x:y:xs) = (y:x:xs) : map (x:) (swap (y:xs)) +swap [] = internalError "Similarity" "swap" "empty string" diff --git a/src/Helium/Utils/Texts.hs b/src/Helium/Utils/Texts.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Utils/Texts.hs @@ -0,0 +1,403 @@ +module Helium.Utils.Texts where + +import Data.Maybe + +data Language = English | Dutch deriving Eq + +language :: Language +language = English + +data Arrow a b = a :-> b + +infix 0 :-> + +select :: Language -> [Arrow Language msg] -> msg +select lan table = fromMaybe (error "Texts.select: unknown language") $ + let convert (a :-> b) = (a, b) + in lookup lan (map convert table) + +warning :: String +warning = select language + [ English :-> "Warning" + , Dutch :-> "Waarschuwing" + ] + +hint :: String +hint = select language + [ English :-> "Hint" + , Dutch :-> "Hint" + ] + +parserSyntaxError :: String +parserSyntaxError = select language + [ English :-> "Syntax error" + , Dutch :-> "Syntax fout" + ] + +parserOr :: String +parserOr = select language + [ English :-> "or" + , Dutch :-> "of" + ] + +parserUnknown :: String +parserUnknown = select language + [ English :-> "unknown parse error" + , Dutch :-> "onbekende syntax fout" + ] + +parserExpecting :: String +parserExpecting = select language + [ English :-> "expecting" + , Dutch :-> "verwacht: " + ] + +parserUnexpected :: String +parserUnexpected = select language + [ English :-> "unexpected" + , Dutch :-> "onverwacht: " + ] + +parserEndOfInput :: String +parserEndOfInput = select language + [ English :-> "end of input" + , Dutch :-> "einde van de tekst" + ] + +parserSingleDigitPriority :: String +parserSingleDigitPriority = select language + [ English :-> "priority must be a single digit" + , Dutch :-> "de prioriteit mag maar uit 1 cijfer bestaan" + ] + +parserTypeClass :: String +parserTypeClass = select language + [ English :-> "type class" + , Dutch :-> "type klasse" + ] + +parserTypeConstructor :: String +parserTypeConstructor = select language + [ English :-> "type constructor" + , Dutch :-> "type constructor" + ] + +parserTypeVariable :: String +parserTypeVariable = select language + [ English :-> "type variable" + , Dutch :-> "type variabele" + ] + +parserModuleName :: String +parserModuleName = select language + [ English :-> "module name" + , Dutch :-> "module naam" + ] + +parserVariable :: String +parserVariable = select language + [ English :-> "variable" + , Dutch :-> "variabele" + ] + +parserConstructor :: String +parserConstructor = select language + [ English :-> "constructor" + , Dutch :-> "constructor" + ] + +parserConstructorOperator :: String +parserConstructorOperator = select language + [ English :-> "constructor operator" + , Dutch :-> "constructor operator" + ] + +parserOperator :: String +parserOperator = select language + [ English :-> "operator" + , Dutch :-> "operator" + ] + +parserCharacterLiteral :: String +parserCharacterLiteral = select language + [ English :-> "character literal" + , Dutch :-> "letter constante" + ] + +parserStringLiteral :: String +parserStringLiteral = select language + [ English :-> "string literal" + , Dutch :-> "string constante" + ] + +parserIntegerLiteral :: String +parserIntegerLiteral = select language + [ English :-> "integer literal" + , Dutch :-> "geheel getal" + ] + +parserFloatLiteral :: String +parserFloatLiteral = select language + [ English :-> "floating-point literal" + , Dutch :-> "reeel getal" + ] + +parserKeyword :: String +parserKeyword = select language + [ English :-> "keyword" + , Dutch :-> "gereserveerd woord" + ] + +parserInsertedLBrace :: String +parserInsertedLBrace = select language + [ English :-> "inserted '{'" + , Dutch :-> "ingevoegde '{'" + ] + +parserEndOfFile :: String +parserEndOfFile = select language + [ English :-> "end of file" + , Dutch :-> "einde van het bestand" + ] + +parserNextInBlock :: String +parserNextInBlock = select language + [ English :-> "next in block (based on layout)" + , Dutch :-> "volgende in blok (d.m.v. inspringing)" + ] + +parserEndOfBlock :: String +parserEndOfBlock = select language + [ English :-> "end of block (based on layout)" + , Dutch :-> "einde van het blok (d.m.v. inspringing)" + ] + +parserExpression :: String +parserExpression = select language + [ English :-> "expression" + , Dutch :-> "expressie" + ] + +parserPattern :: String +parserPattern = select language + [ English :-> "pattern" + , Dutch :-> "patroon" + ] + +parserType :: String +parserType = select language + [ English :-> "type" + , Dutch :-> "type" + ] + +parserLiteral :: String +parserLiteral = select language + [ English :-> "literal" + , Dutch :-> "constante" + ] + +parserNumericLiteral :: String +parserNumericLiteral = select language + [ English :-> "numeric literal" + , Dutch :-> "getal" + ] + +parserImportDeclaration :: String +parserImportDeclaration = select language + [ English :-> "import declaration" + , Dutch :-> "import declaratie" + ] + +parserDeclaration :: String +parserDeclaration = select language + [ English :-> "declaration" + , Dutch :-> "declaratie" + ] + +lexerUnterminatedComment :: String +lexerUnterminatedComment = select language + [ English :-> "Unterminated comment" + , Dutch :-> "Commentaar niet afgesloten" + ] + +lexerMissingExponentDigits :: String +lexerMissingExponentDigits = select language + [ English :-> "Missing digits in exponent in floating-point literal" + , Dutch :-> "Geen cijfers in de exponent van een reeel getal" + ] + +lexerUnexpectedChar :: Char -> String +lexerUnexpectedChar c = select language + [ English :-> "Unexpected character '" ++ [c] ++ "'" + , Dutch :-> "Onverwachte letter '" ++ [c] ++ "'" + ] + +lexerIllegalEscapeInChar :: String +lexerIllegalEscapeInChar = select language + [ English :-> "Illegal escape sequence in character literal" + , Dutch :-> "Illegaal escape karakter in letter constante" + ] + +lexerEmptyChar :: String +lexerEmptyChar = select language + [ English :-> "Empty character literal" + , Dutch :-> "Lege letter constante" + ] + +lexerIllegalCharInChar :: String +lexerIllegalCharInChar = select language + [ English :-> "Illegal character in character literal" + , Dutch :-> "Niet toegestaan teken in letter constante" + ] + +lexerNonTerminatedChar :: String +lexerNonTerminatedChar = select language + [ English :-> "Non-terminated character literal" + , Dutch :-> "Niet afgesloten letter constante" + ] + +lexerInfixHint :: String -> String +lexerInfixHint name = select language + [ English :-> "To write a function in infix notation, use backquotes: `" ++ name ++ "`" + , Dutch :-> "Om een functie infix te schrijven gebruik je backquotes: `" ++ name ++ "`" + ] + +lexerEOFInChar :: String +lexerEOFInChar = select language + [ English :-> "End of file in character literal" + , Dutch :-> "Einde van bestand in letter constante" + ] + +lexerEOFInString :: String +lexerEOFInString = select language + [ English :-> "End of file in string literal" + , Dutch :-> "Einde van bestand in tekst constante" + ] + +lexerIllegalEscapeInString :: String +lexerIllegalEscapeInString = select language + [ English :-> "Illegal escape sequence in string literal" + , Dutch :-> "Illegaal escape karakter in tekst constante" + ] + +lexerNewLineInString :: String +lexerNewLineInString = select language + [ English :-> "Newline in string literal (expecting \")" + , Dutch :-> "Einde van regel in een tekst (gebruik \" om de tekst te sluiten)" + ] + +lexerIllegalCharInString :: String +lexerIllegalCharInString = select language + [ English :-> "Illegal character in string literal" + , Dutch :-> "Niet toegestaan teken in tekst constante" + ] + +lexerTooManyClose :: Show a => a -> String +lexerTooManyClose c = select language + [ English :-> "Close bracket " ++ show c ++ " but no open bracket" + , Dutch :-> "Haakje " ++ show c ++ " wordt gesloten maar nergens geopend" + ] + +lexerUnexpectedClose :: (Show a, Show b) => a -> b -> [String] +lexerUnexpectedClose c1 c2 = select language + [ English :-> [ "Unexpected close bracket " ++ show c1 + , "Expecting a close bracket for " ++ show c2 + ] + , Dutch :-> [ "Onverwacht sluithaakje " ++ show c1 + , "Sluithaakje voor " ++ show c2 ++ " wordt nog verwacht" + ] + ] + +lexerStillOpenAtEOF :: [String] -> String +lexerStillOpenAtEOF [s] = select language + [ English :-> "Bracket " ++ s ++ " is never closed" + , Dutch :-> "Sluithaakje voor " ++ s ++ " wordt nog verwacht" + ] +lexerStillOpenAtEOF xs = select language + [ English :-> "The following brackets are never closed: " ++ commasAnd xs + , Dutch :-> "De volgende haakjes worden nergens gesloten: " ++ kommasEn xs + ] + +lexerCorrectFloats :: String +lexerCorrectFloats = select language + [ English :-> "Correct examples of Floats: 3.14 0.2 4e-13 5E+1 6.7e1" + , Dutch :-> "Correcte voorbeelden van reeele getallen: 3.14 0.2 4e-13 5E+1 6.7e1" + ] + +lexerCorrectChars :: String +lexerCorrectChars = select language + [ English :-> "Correct examples of Chars: 'a' '\\n' '&'" + , Dutch :-> "Correcte voorbeelden van letters: 'a' '\\n' '&'" + ] + +lexerCorrectStrings :: String +lexerCorrectStrings = select language + [ English :-> "Correct examples of Strings: \"Helium is cool\" \"abc\\ndef\" \"\"" + , Dutch :-> "Correcte voorbeelden van teksten: \"Helium is geweldig\" \"abc\\ndef\" \"\"" + ] + +lexerTabCharacter :: [String] +lexerTabCharacter = select language + [ English :-> [ "Tab character encountered; may cause problems with the layout rule" + , "Configure your editor to replace tabs by spaces" + ] + , Dutch :-> [ "Tab karakters kunnen problemn opleveren met de layout rule" + , "Stel je editor zo in dat hij tabs vervangt door spaties" + ] + ] + +lexerLooksLikeFloatNoFraction :: String -> [String] +lexerLooksLikeFloatNoFraction digits = select language + [ English :-> [ "Integer immediately followed by function composition (.)" + , "If a Float was meant, write \"" ++ digits ++ ".0\"" + , "Otherwise, insert a space for readability" + ] + , Dutch :-> [ "Geheel getal direct gevolgd door functie compositie (.)" + , "Als je een reeel getal bedoelde, schrijf dan \"" ++ digits ++ ".0\"" + , "Voeg anders een spatie in voor leesbaarheid" + ] + ] + +lexerLooksLikeFloatNoDigits :: String -> [String] +lexerLooksLikeFloatNoDigits fraction = select language + [ English :-> [ "Function composition (.) immediately followed by number" + , "If a Float was meant, write \"0." ++ fraction ++ "\"" + , "Otherwise, insert a space for readability" + ] + , Dutch :-> [ "Functie compositie (.) direct gevolgd door een getal" + , "Als je een reeel getal bedoelde, schrijf dan \"0." ++ fraction ++ "\"" + , "Voeg anders een spatie in voor leesbaarheid" + ] + ] + +lexerNestedComment :: [String] +lexerNestedComment = select language + [ English :-> [ "Syntax colouring usually can not handle nested comments" + , "Some of your code may be in comments but not visibly so" + ] + , Dutch :-> [ "Syntax kleuring van editor kan meestal niet overweg met genest commentaar" + , "Het kan zo zijn dat een deel van je code in commentaar staat maar dat je dat niet ziet" + ] + ] + +lexerCommentOperator :: [String] +lexerCommentOperator = select language + [ English :-> [ "Syntax colouring usually can not handle names containing --" + , "If you wanted to start a comment, write spaces around --" + ] + , Dutch :-> [ "Syntax kleuring van editor kan meestal niet overweg met namen die -- bevatten" + , "Als je commentaar wilde beginnen schrijf dan spaties voor en na --" + ] + ] + + +commasAnd :: [String] -> String +commasAnd [] = [] +commasAnd [x] = x +commasAnd (x:xs) = x ++ concatMap (", " ++) (init xs) ++ " and " ++ last xs + +kommasEn :: [String] -> String +kommasEn [] = [] +kommasEn [x] = x +kommasEn (x:xs) = x ++ concatMap (", " ++) (init xs) ++ " en " ++ last xs + diff --git a/src/Helium/Utils/Utils.hs b/src/Helium/Utils/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Helium/Utils/Utils.hs @@ -0,0 +1,138 @@ +{-| Module : Utils + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + Some Prelude-like functions +-} + +module Helium.Utils.Utils where + +import Data.IORef + +import GHC.IO (unsafePerformIO) +import Data.List (group, groupBy, sort, elemIndex) +import qualified Control.Exception as CE (catch, IOException) +import System.FilePath +import Helium.Utils.Logger + +-- | Concrete representation of holes +hole :: String +hole = "?" + +------------------------------------------------------- +-- String utils +------------------------------------------------------- +ltrim :: String -> String +ltrim (' ':xs) = ltrim xs +ltrim xs = xs + +rtrim :: String -> String +rtrim = reverse . ltrim . reverse + +trim :: String -> String +trim = ltrim . rtrim + +commaList :: [String] -> String +commaList [] = "" +commaList [x] = x +commaList (x:xs) = x ++ ", " ++ commaList xs + +------------------------------------------------------- +-- Tuples +------------------------------------------------------- + +fst3 :: (a, b, c) -> a +fst3 (a,_,_) = a + +snd3 :: (a, b, c) -> b +snd3 (_,a,_) = a + +thd3 :: (a, b, c) -> c +thd3 (_,_,a) = a + +fst4 :: (a, b, c, d) -> a +fst4 (a,_,_,_) = a + +snd4 :: (a, b, c, d) -> b +snd4 (_,a,_,_) = a + +thd4 :: (a, b, c, d) -> c +thd4 (_,_,a,_) = a + +fth4 :: (a, b, c, d) -> d +fth4 (_,_,_,a) = a + +------------------------------------------------------- + +throw :: String -> IO a +throw = ioError . userError + +groupAll :: Ord a => [a] -> [[a]] +groupAll = group.sort + +groupAllBy :: Ord a => (a -> a -> Bool) -> [a] -> [[a]] +groupAllBy eq = groupBy eq.sort + +{-- Just for renaming elemIndex to a more usual name -} +indexOf :: Eq a => a -> [a] -> Maybe Int +indexOf = elemIndex + +{--- Returns the index of the last occurrence of the given element in the given list -} +lastIndexOf :: Eq a => a -> [a] -> Maybe Int +lastIndexOf x xs = + case indexOf x (reverse xs) of + Nothing -> Nothing + Just idx -> Just (length xs - idx - 1) + +combinePathAndFile :: String -> String -> String +combinePathAndFile path file = + case path of + "" -> file + _ -> path ++ [pathSeparator] ++ file + +-- Split file name +-- e.g. /docs/haskell/Hello.hs => +-- filePath = /docs/haskell baseName = Hello ext = hs +-- IMPORTANT!!! There is one more copy of splitFilePath in texthint and a similar function in LoggerEnabled +splitFilePath :: String -> (String, String, String) +splitFilePath filePath = + let slashes = "\\/" + (revFileName, revPath) = span (`notElem` slashes) (reverse filePath) + (baseName, ext) = span (/= '.') (reverse revFileName) + in (reverse revPath, baseName, dropWhile (== '.') ext) + +-- unsafePerformIO only to be able to make an error report +-- in case of an internal error +refToCurrentFileName :: IORef String +refToCurrentFileName = unsafePerformIO (newIORef "") + +-- unsafePerformIO only to be able to make an error report +-- in case of an internal error +refToCurrentImported :: IORef [String] +refToCurrentImported = unsafePerformIO (newIORef []) + +internalError :: String -> String -> String -> a +internalError moduleName functionName message = unsafePerformIO $ do + action `CE.catch` handler + return . error . unlines $ + [ "" + , "INTERNAL ERROR - " ++ message + , "** Module : " ++ moduleName + , "** Function : " ++ functionName + ] + where + handler :: CE.IOException -> IO () + handler _ = return () + + action :: IO () + action = do -- internal errors are automatically logged + curFileName <- readIORef refToCurrentFileName + curImports <- readIORef refToCurrentImported + logInternalError (Just (curImports,curFileName)) {- no debugging, we can't get to the command-line option DebugLogger here -} + +maxInt, minInt :: Integer +maxInt = 1073741823 +minInt = -1073741823 diff --git a/src/Makefile b/src/Makefile new file mode 100644 --- /dev/null +++ b/src/Makefile @@ -0,0 +1,165 @@ +#----------------------------------------------------------------------- +# Compiling attribute grammar code for The Helium Compiler +# This Makefile only needs to be invoked after modifying files with +# extension .ag. Otherwise it suffices to use cabal install. +#----------------------------------------------------------------------- + +# make - build Haskell sources out of AG code +# make cleanag - remove all .hs files that are derivatives of .ag files + +default: all +all: ag + +AG = uuagc -P Helium/Syntax -P Helium/StaticAnalysis/StaticChecks -P Helium/StaticAnalysis/Inferencers -P Helium/CodeGeneration -P Helium/StaticAnalysis/Directives +AG_OPTS = -mscfrw --kennedywarren + +# AG sources +AGSOURCES = \ + Helium/Syntax/UHA_Pretty.hs \ + Helium/Syntax/UHA_OneLine.hs \ + Helium/StaticAnalysis/StaticChecks/StaticChecks.hs \ + Helium/StaticAnalysis/Inferencers/TypeInferencing.hs \ + Helium/StaticAnalysis/Inferencers/KindInferencing.hs \ + Helium/CodeGeneration/CodeGeneration.hs \ + Helium/Syntax/UHA_Syntax.hs \ + Helium/ModuleSystem/ExtractImportDecls.hs \ + Helium/StaticAnalysis/Directives/TS_Syntax.hs \ + Helium/StaticAnalysis/Directives/TS_Apply.hs \ + Helium/StaticAnalysis/Directives/TS_Analyse.hs \ + Helium/StaticAnalysis/Directives/TS_CoreSyntax.hs \ + Helium/StaticAnalysis/Directives/TS_ToCore.hs \ + Helium/Parser/ResolveOperators.hs + +libraries: + @echo "****************************************************" + @echo " Libraries (with overloading)" + @echo "****************************************************" + cd ../lib; $(MAKE) + @echo "****************************************************" + @echo " Simple libraries (without overloading)" + @echo "****************************************************" + cd ../lib/simple; $(MAKE) + +# AG sources + +ag : $(AGSOURCES) + +cleanag : + $(RM) $(AGSOURCES) + +ifdef AG +Helium/Parser/ResolveOperators.hs : \ + Helium/Parser/ResolveOperators.ag \ + Helium/Syntax/UHA_Syntax.ag + # AG ResolveOperators + $(AG) $(AG_OPTS) --self --module=Helium.Parser.ResolveOperators Helium/Parser/ResolveOperators.ag + +Helium/Syntax/UHA_Pretty.hs : \ + Helium/Syntax/UHA_Pretty.ag Helium/Syntax/UHA_Syntax.ag + # AG UHA_Pretty + $(AG) $(AG_OPTS) --module=Helium.Syntax.UHA_Pretty Helium/Syntax/UHA_Pretty.ag + +Helium/Syntax/UHA_OneLine.hs : \ + Helium/Syntax/UHA_OneLine.ag Helium/Syntax/UHA_Syntax.ag + # AG UHA_OneLine + $(AG) $(AG_OPTS) --self --module=Helium.Syntax.UHA_OneLine Helium/Syntax/UHA_OneLine.ag + +Helium/StaticAnalysis/StaticChecks/StaticChecks.hs : \ + Helium/StaticAnalysis/StaticChecks/StaticChecks.ag \ + Helium/StaticAnalysis/StaticChecks/KindChecking.ag \ + Helium/StaticAnalysis/StaticChecks/TopLevelErrors.ag \ + Helium/StaticAnalysis/StaticChecks/MiscErrors.ag \ + Helium/StaticAnalysis/StaticChecks/Warnings.ag \ + Helium/StaticAnalysis/StaticChecks/ExportErrors.ag \ + Helium/StaticAnalysis/StaticChecks/Collect.ag \ + Helium/StaticAnalysis/StaticChecks/HeliumPartialSyntax.ag \ + Helium/StaticAnalysis/StaticChecks/Scope.ag \ + Helium/StaticAnalysis/StaticChecks/ScopeErrors.ag \ + Helium/Syntax/UHA_Syntax.ag + + # AG StaticAnalysis + $(AG) $(AG_OPTS) --self --module=Helium.StaticAnalysis.StaticChecks.StaticChecks Helium/StaticAnalysis/StaticChecks/StaticChecks.ag + +Helium/StaticAnalysis/Inferencers/TypeInferencing.hs : \ + Helium/StaticAnalysis/Inferencers/TypeInferencing.ag \ + Helium/StaticAnalysis/Inferencers/TypeInferenceRules.ag \ + Helium/StaticAnalysis/Inferencers/TypeInferenceOverloading.ag \ + Helium/StaticAnalysis/Inferencers/TypeInferenceCollect.ag \ + Helium/StaticAnalysis/Inferencers/TypeInferenceInfo.ag \ + Helium/StaticAnalysis/Inferencers/PatternMatchWarnings.ag \ + Helium/StaticAnalysis/Inferencers/LocalInfo.ag \ + Helium/StaticAnalysis/Inferencers/GlobalInfo.ag \ + Helium/StaticAnalysis/StaticChecks/HeliumPartialSyntax.ag \ + Helium/Syntax/UHA_Syntax.ag \ + Helium/StaticAnalysis/StaticChecks/Scope.ag\ + Helium/StaticAnalysis/Directives/TS_PatternMatching.ag + + # AG TypeInferencing + $(AG) $(AG_OPTS) --self --module=Helium.StaticAnalysis.Inferencers.TypeInferencing Helium/StaticAnalysis/Inferencers/TypeInferencing.ag + +Helium/StaticAnalysis/Inferencers/KindInferencing.hs : \ + Helium/StaticAnalysis/Inferencers/KindInferencing.ag \ + Helium/Syntax/UHA_Syntax.ag \ + + # AG TypeInferencing + $(AG) $(AG_OPTS) --self --module=Helium.StaticAnalysis.Inferencers.KindInferencing Helium/StaticAnalysis/Inferencers/KindInferencing.ag + +Helium/CodeGeneration/CodeGeneration.hs : \ + Helium/CodeGeneration/CodeGeneration.ag \ + Helium/Syntax/UHA_Syntax.ag \ + Helium/CodeGeneration/ToCoreModule.ag \ + Helium/CodeGeneration/ToCoreDecl.ag \ + Helium/CodeGeneration/ToCoreExpr.ag \ + Helium/CodeGeneration/ToCorePat.ag \ + Helium/CodeGeneration/ToCoreName.ag + # AG CodeGeneration + $(AG) $(AG_OPTS) --self --module=Helium.CodeGeneration.CodeGeneration Helium/CodeGeneration/CodeGeneration.ag + +Helium/Syntax/UHA_Syntax.hs : Helium/Syntax/UHA_Syntax.ag + # AG UHA_Syntax + $(AG) -dmr --module=Helium.Syntax.UHA_Syntax Helium/Syntax/UHA_Syntax.ag + +Helium/ModuleSystem/ExtractImportDecls.hs : \ + Helium/ModuleSystem/ExtractImportDecls.ag \ + Helium/CodeGeneration/ToCoreName.ag \ + Helium/Syntax/UHA_Syntax.ag + # AG ExtractImportDecls + $(AG) $(AG_OPTS) --self --module=Helium.ModuleSystem.ExtractImportDecls Helium/ModuleSystem/ExtractImportDecls.ag + +Helium/StaticAnalysis/Directives/TS_Syntax.hs : \ + Helium/StaticAnalysis/Directives/TS_Syntax.ag + # AG TS_Syntax + $(AG) -dmr --module=Helium.StaticAnalysis.Directives.TS_Syntax Helium/StaticAnalysis/Directives/TS_Syntax.ag + +Helium/StaticAnalysis/Directives/TS_Analyse.hs : \ + Helium/StaticAnalysis/Directives/TS_Syntax.ag \ + Helium/StaticAnalysis/Directives/TS_Collect.ag \ + Helium/StaticAnalysis/Directives/TS_Analyse.ag \ + Helium/Syntax/UHA_Syntax.ag + # AG TS_Analyse + $(AG) $(AG_OPTS) --self --module=Helium.StaticAnalysis.Directives.TS_Analyse Helium/StaticAnalysis/Directives/TS_Analyse.ag + +Helium/StaticAnalysis/Directives/TS_Apply.hs : \ + Helium/StaticAnalysis/Directives/TS_Syntax.ag \ + Helium/StaticAnalysis/Directives/TS_Collect.ag \ + Helium/StaticAnalysis/Directives/TS_Apply.ag \ + Helium/StaticAnalysis/Directives/TS_CoreSyntax.ag \ + Helium/Syntax/UHA_Syntax.ag \ + # AG TS_Syntax + $(AG) -mscfw --module=Helium.StaticAnalysis.Directives.TS_Apply Helium/StaticAnalysis/Directives/TS_Apply.ag + +Helium/StaticAnalysis/Directives/TS_CoreSyntax.hs : \ + Helium/StaticAnalysis/Directives/TS_CoreSyntax.ag \ + # AG TS_CoreSyntax + $(AG) -md --module=Helium.StaticAnalysis.Directives.TS_CoreSyntax Helium/StaticAnalysis/Directives/TS_CoreSyntax.ag + +Helium/StaticAnalysis/Directives/TS_ToCore.hs : \ + Helium/StaticAnalysis/Directives/TS_Syntax.ag \ + Helium/StaticAnalysis/Directives/TS_Collect.ag \ + Helium/StaticAnalysis/Directives/TS_ToCore.ag \ + Helium/Syntax/UHA_Syntax.ag \ + Helium/Syntax/UHA_OneLine.ag + # AG TS_Syntax + $(AG) -mscrfw --self --module=Helium.StaticAnalysis.Directives.TS_ToCore Helium/StaticAnalysis/Directives/TS_ToCore.ag +endif + diff --git a/src/RunHelium/Main.hs b/src/RunHelium/Main.hs new file mode 100644 --- /dev/null +++ b/src/RunHelium/Main.hs @@ -0,0 +1,105 @@ +{-| Module : Main + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + The wrapper for running lvmrun (for a particular installation of helium) + +-} + +module Main where + +import Data.Maybe(fromMaybe) +import System.Environment(getArgs) +import System.FilePath(joinPath, pathSeparator) +import System.Process(system) +import System.Exit +import System.Directory(findExecutable,getTemporaryDirectory) +import Helium.Main.Args +import TextHint.ConfigFile +import Paths_helium + +data State = + State + { maybeModName :: Maybe String + , maybeFileName :: Maybe String + , tempDir :: String + , compOptions :: [String] -- Contains both options for helium as well as lvmrun. + -- For lvmrun only the -P/--lvmpath options are selected to be passed on + } + +lvmrun :: String +lvmrun = "lvmrun" + +slashify :: String -> String +slashify xs = if last xs == pathSeparator then xs else xs ++ [pathSeparator] + +main :: IO () +main = do + canWeRun <- findExecutable lvmrun + case canWeRun of + Nothing -> do + putStrLn "Fatal error: lvmrun cannot be found in your system PATH.\nDid you run `cabal install lvmrun` yet?" + exitWith (ExitFailure 1) + Just _ -> return () + + -- Read all configuration info first + configFullname <- getDataFileName configFilename + configInfo <- + readConfig configFullname + tempDirFromEnv <- case lookup temppathKey configInfo of + Nothing -> getTemporaryDirectory + Just xs -> return xs + let configOptions = extractOptions configInfo + + -- Load command-line parameter module + -- If the final parameter happens to refer to a source name, then that file is loaded. + args <- getArgs + + -- Delete empty option strings since they screw things up + (options, srcFilename) <- processRunHeliumArgs (filter (/= "") configOptions ++ args) -- args take precedence over config file + let (fpath,filename,_) = splitFilePath (fromMaybe "" srcFilename) + let lvmFilename = joinPath [fpath, filename ++ ".lvm"] + + -- We can now assume the options are correct, and if maybeFileName is a Just, then we load this as file. + -- This might fail as an ordinary load might. + + baseLibs <- getDataFileName $ + if overloadingFromOptions options + then slashify "lib" + else slashify "lib" ++ slashify "simple" -- Where the base libs are. + + let initialState = + State { tempDir = slashify tempDirFromEnv + , maybeModName = Nothing + , maybeFileName = Nothing + , compOptions = ["-P" ++ baseLibs] -- Only -P is needed for lvmrun + } + + -- Enter read-eval-print loop + executeModule lvmFilename initialState + + return () + +executeModule :: String -> State -> IO () +executeModule fileName state = do + let invocation = "\"" ++ "lvmrun\" " ++ unwords (compOptions state) ++ " "++ fileName + _ <- sys invocation + return () + +-- Split file name +-- e.g. /docs/haskell/Hello.hs => +-- filePath = /docs/haskell baseName = Hello ext = hs +splitFilePath :: String -> (String, String, String) +splitFilePath filePath = + let slashes = "\\/" + (revFileName, revPath) = span (`notElem` slashes) (reverse filePath) + (baseName, ext) = span (/= '.') (reverse revFileName) + in (reverse revPath, baseName, dropWhile (== '.') ext) + +-- Local sys in case we want to impose additional side effects +sys :: String -> IO ExitCode +sys = system + diff --git a/src/TextHint/ConfigFile.hs b/src/TextHint/ConfigFile.hs new file mode 100644 --- /dev/null +++ b/src/TextHint/ConfigFile.hs @@ -0,0 +1,108 @@ +module TextHint.ConfigFile ( + Config, + readConfig, + extractOptions, + configFilename, + temppathKey, + unknown, + passToHelium, + trim) where + + +import Control.Monad +import Data.Char +import Data.Maybe +import Text.ParserCombinators.Parsec + +import Helium.Main.Args + +type Config = [(String,String)] + +-- Constants for configuration files +configFilename :: String +configFilename = "hint.conf" +temppathKey :: String +temppathKey = "temppath" +unknown :: String +unknown = "" +passToHelium :: [String] +passToHelium = ["overloadingon", "loggingon", "host", "port", + "lvmpaths", "additionalheliumparameters"] + +-- Thanks to Bryan OÕSullivan, I might upgrade this later to something more in +-- the style of the Helium parser. +-- TODO deal with empty lines AT THE END of the config file. +ident :: Parser String +ident = do c <- letter <|> char '_' + cs <- many (letter <|> digit <|> char '_') + return (c:cs) + "identifier" + +comment :: Parser () +comment = do _ <- char '#' + skipMany (noneOf "\r\n") + "comment" + +{- +eol :: Parser () +eol = do oneOf "\n\r" + return () + "end of line" +-} + +item :: Parser (String, String) +item = do key <- ident + skipMany space + _ <- char '=' + value <- many (noneOf "\n\r") + _ <- newline + return (key, strip value) + where strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace + +line :: Parser (Maybe (String, String)) +line = do skipMany space + try (comment >> return Nothing) <|> liftM Just item + +file :: Parser [(String, String)] +file = do ls <- many line + return (catMaybes ls) + +readConfig :: SourceName -> IO Config +readConfig name = do{ result <- parseFromFile file name + ; case result of + Left err -> do{ print err + ; putStrLn "Error" + ; return [] + } + Right xs -> return (reverse xs) + } + +extractOptions :: Config -> [String] +extractOptions [] = [] +extractOptions ((k,v):xs) = + if k `elem` passToHelium then + tfm k : rest + else + rest + where + rest = extractOptions xs + tfm x = case x of + "overloadingon" + | v == "false" -> show NoOverloading + | otherwise -> show Overloading + "loggingon" + | v == "false" -> show DisableLogging + | otherwise -> show EnableLogging + "host" -> show (Host v) + "port" -> show (Port (read v)) + "lvmpaths" + | trim v == "" -> "" + | otherwise -> show (LvmPath v) + "additionalheliumparameters" -> v + _ -> error "Internal error in RunHelium/Main.hs" + + +trim :: String -> String +trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace + + diff --git a/src/TextHint/Main.hs b/src/TextHint/Main.hs new file mode 100644 --- /dev/null +++ b/src/TextHint/Main.hs @@ -0,0 +1,491 @@ +{-| Module : Main + License : GPL + + Maintainer : helium@cs.uu.nl + Stability : experimental + Portability : portable + + The textual Helium interpreter + +-} + +module Main where + +import Data.Char +import Data.List(isInfixOf, isPrefixOf, isSuffixOf) +import Control.Monad +import System.IO(stdout, hFlush) +import Data.IORef ( IORef, readIORef, newIORef, writeIORef ) +import System.IO.Unsafe ( unsafePerformIO ) +import System.Environment(getArgs) +import System.Process(system) +import System.FilePath +import System.Exit +import System.Directory +import qualified Control.Exception as CE (catch, IOException) +import Helium.Main.Args +import TextHint.ConfigFile +import Paths_helium + +data State = + State + { maybeModName :: Maybe String + , maybeFileName :: Maybe String + , tempDir :: String + -- , binDir :: String + , compOptions :: [String] -- Contains both options for helium as well as lvmrun. + -- For lvmrun only the -P/--lvmpath options are selected to be passed on + } + +-- The following three definitions are used to support the alert flag +-- for redoing a compilation and logging the compilation in a special way. +refToPreviousInvocation :: IORef (String, String) +refToPreviousInvocation = unsafePerformIO (newIORef ("", "")) + +getPreviousInvocation :: (String, String) +getPreviousInvocation = unsafePerformIO (readIORef refToPreviousInvocation) + +setPreviousInvocation :: String -> String -> IO () +setPreviousInvocation heliumInvocation redirect = + writeIORef refToPreviousInvocation (heliumInvocation, redirect) + +header :: String +header = unlines + [ " _ _ _ " + , "| | | (_) " + , "| |__ ___| |_ _ _ _ __ ___ -- Welcome to the Helium interpreter --" + , "| '_ \\ / _ \\ | | | | | '_ ` _ \\ ---------------------------------------" + , "| | | | __/ | | |_| | | | | | | -- Type an expression to evaluate --" + , "|_| |_|\\___|_|_|\\__,_|_| |_| |_| -- or a command (:? for a list) --" + ] + + +slashify :: String -> String +slashify xs = if last xs == pathSeparator then xs else xs ++ [pathSeparator] + +lvmrun :: String +lvmrun = "lvmrun" + +main :: IO () +main = do + canWeRun <- findExecutable lvmrun + case canWeRun of + Nothing -> do + putStrLn "Fatal error: lvmrun cannot be found in your system PATH.\nDid you run `cabal install lvmrun` yet?" + exitWith (ExitFailure 1) + Just _ -> return () + + -- Read all configuration info first + configFullname <- getDataFileName configFilename + configInfo <- + readConfig configFullname + + tempDirFromEnv <- case lookup temppathKey configInfo of + Nothing -> getTemporaryDirectory + Just xs -> return xs + + let configOptions = extractOptions configInfo + + -- Load command-line parameter module + -- If the final parameter happens to refer to a source name, then that file is loaded. + args <- getArgs + + -- Delete empty option strings since they screw things up + (options, maybeFilename) <- processTexthintArgs (filter (/= "") configOptions ++ args) -- args take precedence over config file + + -- We can now assume the options are correct, and if maybeFileName is a Just, then we load this as file. + -- This might fail as an ordinary load might. + + baseLibs <- getDataFileName $ + if overloadingFromOptions options + then slashify "lib" + else slashify "lib" ++ slashify "simple" -- Where the base libs are. + + let initialState = + State { tempDir = slashify tempDirFromEnv + , maybeModName = Nothing + , maybeFileName = Nothing + , compOptions = ("-P"++baseLibs): map show options -- -P is needed for lvmrun + } + + stateAfterLoad <- + case maybeFilename of + Just filename -> + cmdLoadModule filename initialState + Nothing -> + return initialState + + -- Logo + putStrLn header + + -- Enter read-eval-print loop + _ <- loop stateAfterLoad + + return () + +loop :: State -> IO State +loop state = do + putStr (prompt state) + hFlush stdout + command' <- getLine + let command = trim command' + newState <- case command of + (':':cmd:rest) -> + processCommand (toLower cmd) (trim rest) state + (':':_) -> do + putStrLn "Expecting command after colon. Type :? for help" + return state + expression -> + if null expression + then return state + else processExpression expression state + loop newState + where + prompt :: State -> String + prompt State{ maybeModName = Nothing} = "Prelude> " + prompt State{ maybeModName = Just modName} = modName ++ "> " + +processCommand :: Char -> String -> State -> IO State +processCommand cmd rest state = + case cmd of + '!' -> cmdSystem rest state + 't' -> cmdShowType rest state + 'l' -> cmdLoadModule rest state + 'r' -> cmdReloadModule state + 'a' -> cmdAlert rest state + 'b' -> cmdBrowse state + 'h' -> cmdHelp state + '?' -> cmdHelp state + 'q' -> do putStrLn "[Leaving texthint]" + exitSuccess + _ -> do putStrLn "Command not recognised. Type :? for help" + return state + +------------------------ +-- Command :! +------------------------ + +cmdSystem :: String -> State -> IO State +cmdSystem command state = do + _ <- system command + return state + +------------------------ +-- Command :t +------------------------ + +cmdShowType :: String -> State -> IO State +cmdShowType [] state = do + putStrLn "ERROR: Expecting expression after :t" + return state +cmdShowType expression state = do + let moduleContents = expressionModule expression state + writeInternalModule moduleContents state + (success, output) <- compileInternalModule "-i" state + if success then do + let typeLine = filter (interpreterMain `isPrefixOf`) (map trim (lines output)) + unless (null typeLine) $ do + let typeString = + trim + . dropWhile (== ':') + . dropWhile isSpace + . drop (length interpreterMain) + . head + $ typeLine + putStrLn (expression ++ " :: " ++ typeString) + else + putStr (removeEvidence output) + return state + +------------------------ +-- Command :l +------------------------ + +cmdLoadModule :: String -> State -> IO State +cmdLoadModule [] state = -- unload + return state{maybeModName = Nothing, maybeFileName = Nothing } +cmdLoadModule fileName state = do + fileExists <- doesFileExist fileName + if fileExists + then loadExistingModule fileName state + else do + let fileNameWithHS = fileName ++ ".hs" + fileExistsWithHS <- doesFileExist fileNameWithHS + if fileExistsWithHS + then loadExistingModule fileNameWithHS state + else do + putStr $ "ERROR - Unable to open file \"" ++ fileName ++ "\"\n" + return state + +loadExistingModule :: String -> State -> IO State +loadExistingModule fileName state = do + let (path, baseName, _) = splitFilePath fileName + unless (null path) $ + setCurrentDirectory path + let newState = state{ maybeModName = Just baseName, maybeFileName = Just fileName } + moduleContents = expressionModule "()" newState + writeInternalModule moduleContents newState + (_, output) <- compileInternalModule "" newState + putStr (removeEvidence output) + return newState + +------------------------ +-- Command :r +------------------------ + +cmdReloadModule :: State -> IO State +cmdReloadModule state = + case maybeModName state of + Nothing -> return state + Just name -> cmdLoadModule name state + +------------------------ +-- Command :a +------------------------ + +cmdAlert :: String -> State -> IO State +cmdAlert msg state = do + let (invocation, outputFilePath) = getPreviousInvocation + -- putStrLn (" -- " ++ invocation ++ " -- " ++ outputFilePath) + when (invocation /= "") + (do + (_, output) <- execCompileModule (invocation ++ " --alert=\"" ++ escape alertESCAPABLES msg ++ "\" -b --enable-logging ") outputFilePath + putStr (removeEvidence output) + return ()) + return state + +------------------------ +-- Command :b +------------------------ + +cmdBrowse :: State -> IO State +cmdBrowse state = + case maybeModName state of + Nothing -> do + let moduleContents = "import Prelude\n" + writeInternalModule moduleContents state + (_, output) <- compileInternalModule "-I -3 -B" state + putStr (unlines (safeTail (lines output))) + return state + Just modName -> do + (_, output) <- compileModule modName "-i -3 -B" state + putStr (unlines (safeTail (lines output))) + return state + +------------------------ +-- Command :? +------------------------ + +cmdHelp :: State -> IO State +cmdHelp state = do + putStrLn ":h, :? display this help screen" + putStrLn ":l load module" + putStrLn ":l unload module" + putStrLn ":r reload module" + putStrLn ":a alert to previous compile (message optional)" + putStrLn ":t show type of expression" + putStrLn ":b browse definitions in current module" + putStrLn ":! shell command" + putStrLn ":q quit" + return state + +------------------------ +-- Expression +------------------------ + +processExpression :: String -> State -> IO State +processExpression expression state = do + removeLVM state + let moduleContents = expressionModule expression state + writeInternalModule moduleContents state + (success, output) <- compileInternalModule "" state + putStr (removeEvidence output) + when success $ + executeInternalModule state + return state + +------------------------ +-- Interpreter module +------------------------ + +outputFileName, internalModule, interpreterMain :: String +outputFileName = "InterpreterOutput.txt" +internalModule = "Interpreter" +interpreterMain = "interpreter_main" + +internalModulePath :: State -> String +internalModulePath state = tempDir state ++ internalModule + +writeInternalModule :: String -> State -> IO () +writeInternalModule contents state = + writeModule (internalModulePath state) contents + +writeModule :: String -> String -> IO () +writeModule modulePath contents = do + let hsFile = modulePath ++ ".hs" + handler :: CE.IOException -> IO () + handler _ = fatal ("Unable to write to file \"" ++ hsFile ++ "\"") + writeFile hsFile contents + `CE.catch` handler + +compileInternalModule :: String -> State -> IO (Bool, String) +compileInternalModule options state = + compileModule (internalModulePath state) options state + +compileModule :: String -> String -> State -> IO (Bool, String) +compileModule fileName options state = do + let outputFilePath = tempDir state ++ outputFileName + -- putStrLn (fileName ++ "." ++ options ++ "." ++ unwords (compOptions state)) + -- mapM putStrLn (compOptions state) + let heliumInvocation = "helium " ++ unwords (compOptions state) + ++ " " ++ options ++ " " ++ fileName + setPreviousInvocation heliumInvocation outputFilePath + execCompileModule heliumInvocation outputFilePath + +verbose :: String -> Bool +verbose = isInfixOf "--verbose" + +execCompileModule :: String -> String -> IO (Bool, String) +execCompileModule invocation outputFilePath = + let + handler :: CE.IOException -> IO String + handler _ = fatal ("Unable to read from file \"" ++ outputFilePath ++ "\"") + in + do + when (verbose invocation) $ + putStrLn invocation + exitCode <- sys (invocation ++ " > " ++ outputFilePath) + contents <- readFile outputFilePath `CE.catch` handler + return (exitCode == ExitSuccess, contents) + +executeInternalModule :: State -> IO () +executeInternalModule state = + executeModule (internalModulePath state) state + +lvmOptionsFilter :: [String] -> String +lvmOptionsFilter opts = + case lvmPathFromOptions (simplifyOptions (argsToOptions opts)) of + Nothing -> "" + (Just paths) -> "-P" ++ paths + +executeModule :: String -> State -> IO () +executeModule fileName state = do + let invocation = lvmrun ++ " " ++ lvmOptionsFilter (compOptions state) ++ " "++ fileName + _ <- sys invocation + return () + +removeLVM :: State -> IO () +removeLVM state = do + let lvmFile = tempDir state ++ internalModule ++ ".lvm" + lvmExist <- doesFileExist lvmFile + when lvmExist $ removeFile lvmFile + +expressionModule :: String -> State -> String +expressionModule expression state = + unlines + ( case maybeModName state of + Nothing -> [] + Just name -> [ "import " ++ name ] + ++ [ interpreterMain ++ " = " ++ expression ] + ) + +sys :: String -> IO ExitCode +sys = system + +------------------------ +-- Remove evidence +------------------------ + +-- remove evidence that there is an Interpreter module +-- that is compiled each time you type an expression +-- or ask for a type + +removeEvidence :: String -> String +removeEvidence = + unlines . firstState . lines + where + firstState :: [String] -> [String] + firstState [] = [] + firstState (line:ls) + | "Compiling" `isPrefixOf` line && + (internalModule ++ ".hs") `isSuffixOf` line = + interpreterState [] ls + | "Compiling" `isPrefixOf` line = + line : otherModuleState ls + | "is up to date" `isSuffixOf` line = + firstState ls + | otherwise = + line : firstState ls + + interpreterState soFar [] = soFar + interpreterState soFar (line:ls) + | "Compilation successful" `isPrefixOf` line = + firstState ls + | "Compilation" `isPrefixOf` line = + map removePositions soFar ++ firstState ls + | otherwise = + interpreterState (soFar ++ [line]) ls + + otherModuleState [] = [] + otherModuleState (line:ls) + | "Compilation" `isPrefixOf` line = + line : firstState ls + | otherwise = + line : otherModuleState ls + + removePositions line = + let (upToColon, rest) = span (/= ':') line + in if not (all isSpace upToColon) && + all (\c -> isDigit c || c `elem` "(), ") upToColon then + safeTail rest + else + line + +------------------------ +-- Utility functions +------------------------ + +fatal :: String -> IO a +fatal msg = do + putStrLn msg + putStrLn "Make sure that the environment variable TEMP points to a valid directory" + exitWith (ExitFailure 1) + +safeTail :: [a] -> [a] +safeTail (_:xs) = xs +safeTail [] = [] + +contains :: Eq a => [a] -> [a] -> Bool +_ `contains` [] = True +[] `contains` _ = False +(large@(_:rest)) `contains` small = + small `isPrefixOf` large || rest `contains` small + +-- Split file name +-- e.g. /docs/haskell/Hello.hs => +-- filePath = /docs/haskell baseName = Hello ext = hs +splitFilePath :: String -> (String, String, String) +splitFilePath filePath = + let slashes = "\\/" + (revFileName, revPath) = span (`notElem` slashes) (reverse filePath) + (baseName, ext) = span (/= '.') (reverse revFileName) + in (reverse revPath, baseName, dropWhile (== '.') ext) + +-- As copied from Logger.hs + +escapeChar :: Char +escapeChar = '\\'; + +alertESCAPABLES :: String +alertESCAPABLES = ['"', escapeChar] + +-- Escapes all characters from the list escapables +escape :: [Char] -> String -> String +escape _ [] = [] +escape escapables (x:xs) = + if x `elem` escapables + then escapeChar : rest + else rest + where + rest = x : escape escapables xs +